10 REM
20 REM      WEATHER FORECAST PROGRAM by Phil Baughn
30 REM
40 REM      This software program is distributed as "SHAREWARE".  You may
50 REM      feel free to copy and revise it as you like as long as you do
60 REM      not alter or remove the credit information in the program. If
70 REM      you find that you have made some significant improvements and
80 REM      additions to this package, please upload them to my attention
90 REM      either at The MAILROOM RBBS or to Compuserve; User#76044,1535.
100 REM      Enjoy!    Phil Baughn
110 REM
120 REM     Mailing address:          The MAILROOM RBBS-PC
130 REM                               attn.  Phil Baughn
140 REM                               2050 Idle Hour Center
150 REM                               Lexington, KY  40502
160 REM                               Data:  (606)293-5119
170 REM                               Voice: (606)268-0206
180 REM
190 REM     Special Credit to Mssrs. Bernard N. Meisner and Leon F. Graves
200 REM     who developed the Heat Index / Apparent Temperature Formula.
210 REM
220 REM     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
230 REM
240 REM     BELOW TURNS KEYS OFF, SELECTS COLOR OR MONO, TURNS CAPS ON
250 REM
260 DEF SEG=0:POKE 1047,96:DEF SEG
270 KEY OFF:CLS:LOCATE 10,23:INPUT "Do you want Color? (Y)es or (N)o";CLRANS$
280 IF LEFT$(CLRANS$,1)="Y" OR LEFT$(CLRANS$,1)="y" THEN CLRT$="Y":GOTO 330
290 IF LEFT$(CLRANS$,1) <> "N" AND LEFT$(CLRANS$,1) <> "n" THEN GOTO 270
300 CLRT$ = " "
310 REM
320 REM
330 GOSUB 1040
340 REM     GET WELCOME SCREEN AND CREDITS IN ABOVE LINE
350 REM     GET MASTER WELCOME DOCUMENT IN FOLLOWING LINE
360 GOSUB 1330
370 REM
380 REM     PRINT MAIN MENU
390 REM
400 CLS:IF CLRT$ = "Y" THEN COLOR 14
410 LOCATE 9,20:PRINT "1 - WEATHER FORECAST PROGRAM"
420 IF CLRT$ = "Y" THEN COLOR 11
430 LOCATE 11,20:PRINT "2 - WIND CHILL CALCULATION"
440 IF CLRT$ = "Y" THEN COLOR 12
450 LOCATE 13,20:PRINT "3 - TEMPERATURE HUMIDITY INDEX"
460 IF CLRT$ = "Y" THEN COLOR 13
470 LOCATE 15,20:PRINT "4 - HEAT INDEX CALCULATION"
480 IF CLRT$ = "Y" THEN COLOR 14
490 LOCATE 17,20:PRINT "5 - DEW POINT CALCULATION"
500 IF CLRT$ = "Y" THEN COLOR 9
510 LOCATE 5,5:INPUT "ENTER THE NUMBER OF THE WEATHER PROGRAM WHICH YOU WISH TO RUN  ";CHOICE
520 REM
530 REM     GET FORCASTING SUNROUTINE
540 REM
550 IF CHOICE=1 THEN GOSUB 1650 ELSE GOTO 600
560 GOTO 790
570 REM
580 REM     GET WIND CHILL SUBROUTINE
590 REM
600 IF CHOICE=2 THEN GOSUB 3290 ELSE GOTO 650
610 GOTO 790
620 REM
630 REM     GET TEMP-HUMIDITY SUBROUTINE
640 REM
650 IF CHOICE=3 THEN GOSUB 4710 ELSE GOTO 700
660 GOTO 790
670 REM
680 REM     GET HEAT INDEX SUBROUTINE
690 REM
700 IF CHOICE=4 THEN GOSUB 3610 ELSE GOTO 750
710 GOTO 790
720 REM
730 REM     GET DEW POINT SUBROUTINE
740 REM
750 IF CHOICE=5 THEN GOSUB 5230 ELSE GOTO 400
760 REM
770 REM     LOOP OR QUIT
780 REM
790 LOCATE 24,14:INPUT "DO YOU WISH TO DO A DIFFERENT CALCULATION (Y/N)";D$
800 REM
810 REM     LOOP
820 REM
830 IF D$="Y" OR D$="y" THEN GOTO 400
840 REM
850 REM     QUIT WITH EPILOG SCREEN AND RESET IF CLRT$="Y" THEN COLORS TO NORMAL
860 REM     ALSO PLACE CAPS AND NUMBERS LOCK KEYS BACK TO OFF STATUS
870 REM
880 IF CLRT$ = "Y" THEN COLOR 12,0,0
890 CLS:LOCATE 9,23:PRINT "I hope you enjoyed WEATHER and"
900 LOCATE 11,21:PRINT "that your forecast was a good one."
910 LOCATE 15,20:PRINT "Let us here from you on The MAILROOM"
920 LOCATE 17,18:PRINT "Data (606)293-5119 - 9600 Baud Supported"
930 LOCATE 19,37:PRINT "- Phil Baughn"
940 DEF SEG=0:POKE 1047,0:DEF SEG
950 IF CLRT$ = "Y" THEN COLOR 7,0,0
960 LOCATE 24,1
970 END
980 REM     ~~~~~~~~~~~~~~PROGRAM ENDS HERE~~~~~~~~~~~~~~
990 REM
1000 REM     ~~~~~~~~SUBROUTINE MODULES BEGIN HERE~~~~~~~~
1010 REM
1020 REM     WELCOME SCREEN AND CREDITS SUBROUTINE
1030 REM
1040 CLS
1050 WIDTH 80:IF CLRT$ = "Y" THEN COLOR 11,0
1060 LOCATE 5,5:PRINT CHR$(201):LOCATE 5,75:PRINT CHR$(187)
1070 LOCATE 20,5:PRINT CHR$(200):LOCATE 20,75:PRINT CHR$(188)
1080 FOR N=6 TO 19
1090 LOCATE N,5:PRINT CHR$(186)
1100 LOCATE N,75:PRINT CHR$(186)
1110 NEXT N
1120 FOR N=6 TO 74
1130 LOCATE 5,N:PRINT CHR$(205)
1140 LOCATE 20,N:PRINT CHR$(205)
1150 NEXT N
1160 IF CLRT$ = "Y" THEN COLOR 13,0
1170 LOCATE 7,31:PRINT "WEATHER FORCASTING"
1180 LOCATE 9,28:PRINT "DEVELOPED FOR THE IBM-PC"
1190 LOCATE 10,39:PRINT "BY"
1200 LOCATE 11,35:PRINT "PHIL BAUGHN"
1210 LOCATE 13,14:PRINT "Special Thanks For Module Improvements To Sean Gayle,"
1220 LOCATE 14,11:PRINT "John Fleming, & Brad James - Meteorologist, WKYT, Lexington"
1230 LOCATE 16,20:PRINT "Distributed Through The MAILROOM RBBS-PC"
1240 LOCATE 17,29:PRINT "In Lexington, Kentucky"
1250 LOCATE 18,22:PRINT "(606)293-5119   24 Hours - 9600 Baud"
1260 LOCATE 19,21:PRINT "Latest Revision [ 5.1 ];  January 1987"
1261 LOCATE 22,27:PRINT "Press any key when ready..."
1262 IF INKEY$ ="" GOTO 1262
1270 IF CLRT$ = "Y" THEN COLOR 7,0,0
1280 CLS
1290 RETURN
1300 REM
1310 REM     MAIN WELCOME DOCUMENT SUBROUTINE
1320 REM
1330 IF CLRT$ = "Y" THEN COLOR 14,1,1
1340 CLS
1350 PRINT "  "
1360 PRINT "  "
1370 PRINT "    This  program  will provide  you with a very good forcast providing"
1380 PRINT "    you supply the correct  information  as to barometric  pressure and"
1390 PRINT "    wind direction.  This method has been used  for ages  by  sailors &"
1400 PRINT "    the tables  themselves can still be found in  almost  all  editions"
1410 PRINT "    of The Farmers Almanac."
1420 PRINT " "
1430 PRINT "    The other four programs which are included at present;  Wind Chill,"
1440 PRINT "    Dew Point, Temp/Humidity, & Heat Index; can be especially important"
1450 PRINT "    when working outdoors.  Wind Chill tells you the true  FEEL  of the"
1460 PRINT "    temperature  after the wind has it's effect.   It's not always safe"
1470 PRINT "    to simply  look  at the outdoor thermometer!  Humidity also effects"
1480 PRINT "    the temperature.   Higher humidity  levels  cause it to effect your"
1490 PRINT "    body as if it were hotter than the thermometer states."
1500 PRINT "  "
1510 PRINT "    Enjoy the program,   please pass along any  improvements  which you"
1520 PRINT "    may develop  or  additional  modules  which will fit well into  the"
1530 PRINT "    menu.   Listing  the  programs, lines 1-200, [ ie- LIST -200 ] will"
1540 PRINT "    provide you with more detailed contact information."
1550 PRINT "  "
1560 PRINT "  "
1570 PRINT "    Press any key when ready..."
1580 IF INKEY$ ="" GOTO 1580
1590 IF CLRT$ = "Y" THEN COLOR 7,0,0
1600 CLS
1610 RETURN
1620 REM
1630 REM     WIND-BAROMETER FORECASTING SUBROUTINE
1640 REM
1650 CLS:IF CLRT$ = "Y" THEN COLOR 14
1660 LOCATE 2,25:PRINT "WEATHER FORECAST PROGRAM"
1670 IF CLRT$ = "Y" THEN COLOR 5
1680 LOCATE 4,32:PRINT DATE$:LOCATE 5,33:PRINT TIME$
1690 IF CLRT$ = "Y" THEN COLOR 3,0,0
1700 KEY OFF:LOCATE 7,12
1710 INPUT "ENTER CURRENT BAROMETRIC PRESSURE                  ";CBP
1720 IF CBP<25 THEN 1700
1730 IF CBP>35 THEN 1700
1740 LOCATE 8,12
1750 INPUT "WIND DIRECTION IS CURRENTLY FROM THE               ";PWD$
1760 IF PWD$="SW" THEN 1770 ELSE 1800
1770 LOCATE 9,12
1780 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
1790 GOTO 1930
1800 IF PWD$="SE" THEN 1810 ELSE 1840
1810 LOCATE 9,12
1820 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
1830 GOTO 2010
1840 IF PWD$="S" THEN 1880 ELSE 1850
1850 IF PWD$="N" THEN 1880 ELSE 1860
1860 IF PWD$="NW" THEN 1880 ELSE 1870
1870 IF PWD$="NE" THEN 1880 ELSE 2090
1880 LOCATE 18,23
1890 IF CLRT$ = "Y" THEN COLOR 9
1900 PRINT "NO IMMEDIATE CHANGE IS FORECAST"
1910 IF CLRT$ = "Y" THEN COLOR 7,0,0
1920 GOTO 3220
1930 IF PWD$="S" THEN 1950 ELSE 1940
1940 IF PWD$="NW" THEN 1970 ELSE 1990
1950 PWD$="M"
1960 GOTO 2140
1970 PWD$="N"
1980 GOTO 2140
1990 PWD$="O"
2000 GOTO 2140
2010 IF PWD$="NE" THEN 2030 ELSE 2020
2020 IF PWD$="S" THEN 2050 ELSE 2070
2030 PWD$="P"
2040 GOTO 2140
2050 PWD$="Q"
2060 GOTO 2140
2070 PWD$="R"
2080 GOTO 2140
2090 IF PWD$="E" THEN 2110 ELSE 2100
2100 IF PWD$="W" THEN 2130
2110 PWD$="S"
2120 GOTO 2140
2130 PWD$="T"
2140 IF CLRT$ = "Y" THEN COLOR 4
2150 LOCATE 13,12:PRINT "WIND CONDITION CODE IS ",PWD$;
2160 IF CLRT$ = "Y" THEN COLOR 3,0,0
2170 IF CBP>30.01 THEN 2340 ELSE 2180
2180 IF CBP<29.81 THEN 2490 ELSE 2190
2190 LOCATE 10,12
2200 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
2210 IF BM$="F" THEN 2220 ELSE 2290
2220 LOCATE 11,12
2230 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
2240 IF BM$="R" THEN 2250 ELSE 2270
2250 BM$="C6"
2260 GOTO 2560
2270 BM$="C5"
2280 GOTO 2560
2290 IF BM$="R" THEN 2300 ELSE 2320
2300 BM$="C7"
2310 GOTO 2560
2320 BM$="C0"
2330 GOTO 2560
2340 LOCATE 10,12
2350 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
2360 IF BM$="F" THEN 2370 ELSE 2440
2370 LOCATE 11,12
2380 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
2390 IF BM$="R" THEN 2400 ELSE 2420
2400 BM$="C4"
2410 GOTO 2560
2420 BM$="C3"
2430 GOTO 2560
2440 IF BM$="S" THEN 2450 ELSE 2470
2450 BM$="C1"
2460 GOTO 2560
2470 BM$="C2"
2480 GOTO 2560
2490 LOCATE 10,12
2500 INPUT "IS THE PRESSURE RISING (R) OR FALLING (F)          ";BM$
2510 IF BM$="R" THEN 2520 ELSE 2540
2520 BM$="C8"
2530 GOTO 2560
2540 BM$="C9"
2550 GOTO 2560
2560 IF CLRT$ = "Y" THEN COLOR 4
2570 LOCATE 14,12:PRINT "BAROMETRIC CODE IS ",BM$
2580 IF CLRT$ = "Y" THEN COLOR 3,0,0
2590 IF PWD$="O" THEN 1880
2600 IF PWD$="R" THEN 1880
2610 LOCATE 17,18:PRINT "PLEASE WAIT - FORECAST BEING COMPUTED"
2620 FOR X=1 TO 3200:NEXT X
2630 LOCATE 17,18:PRINT "                                                 "
2640 IF PWD$="T" AND BM$="C8" THEN 2840
2650 IF PWD$="M" AND BM$="C7" THEN 2860
2660 IF PWD$="Q" AND BM$="C3" THEN 2890
2670 IF PWD$="Q" AND BM$="C4" THEN 2910
2680 IF PWD$="Q" AND BM$="C9" THEN 2930
2690 IF PWD$="P" AND BM$="C3" THEN 2960
2700 IF PWD$="P" AND BM$="C4" THEN 2980
2710 IF PWD$="P" AND BM$="C5" THEN 2990
2720 IF PWD$="P" AND BM$="C6" THEN 3010
2730 IF PWD$="P" AND BM$="C9" THEN 2930
2740 IF PWD$="S" AND BM$="C3" THEN 3040
2750 IF PWD$="S" AND BM$="C4" THEN 3070
2760 IF PWD$="S" AND BM$="C9" THEN 3120
2770 IF PWD$="N" AND BM$="C1" THEN 3150
2780 IF PWD$="N" AND BM$="C2" THEN 3180
2790 IF PWD$="N" AND BM$="C3" THEN 3200
2800 IF PWD$="N" AND BM$="C7" THEN 2860
2810 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
2820 PRINT "WIND INCREASING; RAIN WITHIN 12 HOURS":GOTO 3220
2830 GOTO 1880
2840 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
2850 PRINT "CLEARING AND COLDER":GOTO 3220
2860 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
2870 PRINT "CLEARING WITHIN A FEW HOURS/"
2880 LOCATE 19,20:PRINT "FAIR FOR SEVERAL DAYS":GOTO 3220
2890 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
2900 PRINT "RAIN WITHIN 24 HOURS":GOTO 3220
2910 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
2920 PRINT "WIND INCREASING; RAIN WITHIN 24 HOURS":GOTO 3220
2930 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 15
2940 PRINT "SEVERE STORM IMMIMENT, FOLLOWED WITHIN 24 HOURS"
2950 LOCATE 19,15:PRINT "BY CLEARING. IN WINTER, COLDER TEMPERATURES.":GOTO 3220
2960 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
2970 PRINT "RAIN WITHIN 12 TO 18 HOURS":GOTO 3220
2980 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
2990 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
3000 PRINT "RAIN WILL CONTINUE FOR 1 TO 2 DAYS":GOTO 3220
3010 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
3020 PRINT "RAIN, WITH HIGH WIND, FOLLOWED WITHIN 36 HOURS BY"
3030 LOCATE 19,15:PRINT "CLEARING. IN WINTER - COLDER TEMPERATURES.":GOTO 3220
3040 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
3050 PRINT "SUMMER - LIGHT WINDS; RAIN MAY NOT FALL FOR"
3060 LOCATE 19,15:PRINT "SEVERAL DAYS.  WINTER - RAIN WITHIN 24 HOURS":GOTO 3220
3070 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
3080 PRINT "SUMMER RAIN PROBABLE 12/24 HOURS.  WINTER"
3090 LOCATE 19,15:PRINT "RAIN OR SNOW, INCREASING WIND; BAD WEATHER"
3100 LOCATE 21,15:PRINT "OFTEN SETS IN WHEN BAROMETER BEGINS TO FALL AND"
3110 LOCATE 23,15:PRINT "WINDS SET IN FROM THE NORTHEAST.":GOTO 3220
3120 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 15
3130 PRINT "SEVERE NORTHEAST GALE AND HEAVY PRECIPITATION,"
3140 LOCATE 19,15:PRINT "IN WINTER - HEAVY SNOW FOLLOWED BY A COLD WAVE":GOTO 3220
3150 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
3160 PRINT "CONTINUED FAIR WEATHER WITH"
3170 LOCATE 19,20:PRINT "NO DECIDED TEMPERATURE CHANGE":GOTO 3220
3180 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
3190 PRINT "FAIR, FOLLOWED WITHIN 2 DAYS BY RAIN":GOTO 3220
3200 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
3210 PRINT "FAIR FOR 2 DAYS WITH SLOWLY RISING TEMPERATURES"
3220 IF CLRT$ = "Y" THEN COLOR 7,0,0
3230 LOCATE 24,17:INPUT "DO YOU WISH TO RUN ANOTHER FORECAST (Y/N)";L$
3240 IF L$="Y" OR L$="y" THEN GOTO 1650
3250 RETURN
3260 REM
3270 REM     WIND CHILL SUBROUTINE
3280 REM
3290 CLS:IF CLRT$ = "Y" THEN COLOR 11
3300 LOCATE 2,27:PRINT "WIND CHILL CALCULATION"
3310 IF CLRT$ = "Y" THEN COLOR 5
3320 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
3330 IF CLRT$ = "Y" THEN COLOR 3,0,0
3340 KEY OFF:LOCATE 7,12
3350 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
3360 LOCATE 8,12
3370 INPUT "ENTER WIND SPEED IN MILES PER HOUR                 ";V
3380 T1=T:V=(V*1609.35)/(3600):TC=33-((T-32)*(5/9))
3390 H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784
3400 IF X<0 THEN X1=T1:GOTO 3520
3410 X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)
3420 IF CLRT$ = "Y" THEN COLOR 3
3430 LOCATE 11,19:PRINT "PLEASE WAIT - WIND CHILL BEING COMPUTED"
3440 FOR ZZ=1 TO 1600:NEXT ZZ
3450 IF CLRT$ = "Y" THEN COLOR 4
3460 LOCATE 13,17:PRINT "T1=T:V=(V*1069.35)/3600:TC=33-((T-32)*(5/9))"
3470 FOR Z=1 TO 800:NEXT Z
3480 LOCATE 14,20:PRINT "H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784"
3490 FOR ZXC=1 TO 800:NEXT ZXC
3500 LOCATE 15,21:PRINT "X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)"
3510 FOR ZX=1 TO 1600:NEXT ZX
3520 IF CLRT$ = "Y" THEN COLOR 13
3530 LOCATE 19,15:PRINT "WIND CHILL TEMPERATURE = ";X1;"DEGREES FAHRENHEIT"
3540 IF CLRT$ = "Y" THEN COLOR 7,0,0
3550 LOCATE 24,19:INPUT "RUN ANOTHER WIND CHILL FACTOR (Y/N)";L$
3560 IF L$="Y" OR L$="y" THEN GOTO 3290
3570 RETURN
3580 REM
3590 REM     HEAT INDEX SUBROUTINE
3600 REM
3610 CLS:IF CLRT$ = "Y" THEN COLOR 11
3620 LOCATE 2,27:PRINT "HEAT INDEX CALCULATION"
3630 IF CLRT$ = "Y" THEN COLOR 5
3640 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
3650 IF CLRT$ = "Y" THEN COLOR 3,0,0
3660 KEY OFF:LOCATE 7,11
3670 INPUT "ENTER THE CURRENT TEMPERATURE IN DEGREES FAHRENHEIT ";TA
3680 U$="F"
3690 LOCATE 8,11
3700 INPUT "ENTER THE RELATIVE HUMIDITY  (`50'= 50% )           ";RH
3710 IF CLRT$ = "Y" THEN COLOR 9
3720 LOCATE 11,18:PRINT "PLEASE WAIT - HEAT INDEX BEING COMPUTED"
3730 FOR ZZ=1 TO 1600:NEXT ZZ
3740 IF CLRT$ = "Y" THEN COLOR 4
3750 LOCATE 13,23:PRINT "Heat Index Is Also Refered To"
3760 FOR Z=1 TO 800:NEXT Z
3770 LOCATE 14,17:PRINT "As The Apparent Temperature.  See The H/I"
3780 FOR ZXC=1 TO 800:NEXT ZXC
3790 LOCATE 15,18:PRINT "Explanation & Danger Table For Details."
3800 FOR ZX=1 TO 1600:NEXT ZX
3810 GOSUB 4150
3820 IF CLRT$ = "Y" THEN COLOR 11
3830 LOCATE 19,19:PRINT "APPARENT TEMPERATURE = ";APPTEMP;" ";U$
3840 IF DF<0 THEN GOTO 3860
3850 GOTO 3870
3860 LOCATE 20,19:PRINT "SEVERE SULTRINESS..."
3870 IF CLRT$ = "Y" THEN COLOR 7,0,0
3880 LOCATE 23,19:INPUT "RUN ANOTHER HEAT INDEX FACTOR (Y/N)";L$
3890 IF L$="Y" OR L$="y" THEN GOTO 3610
3900 LOCATE 24,16:INPUT "View H/I  Explanation & Danger Table? (Y/N)";CT$
3910 IF CT$="N" OR CT$="n" THEN GOTO 4140
3920 IF CLRT$ = "Y" THEN COLOR 14,1,1
3930 CLS
3940 PRINT "  "
3950 PRINT "       Your Present Calculated Heat Index Value Is" APPTEMP" "U$"."
3960 PRINT "  "
3970 PRINT "       When the  Heat Index reaches 130 degrees or higher, Heat"
3980 PRINT "       Strokes or  Sunstrokes are  HIGHLY likely with continued"
3990 PRINT "       exposure!   When the  Heat Index  ranges from 105 to 130"
4000 PRINT "       degrees,  sunstroke, heat exhaustion and heat cramps are"
4010 PRINT "       likely with  prolonged exposure and/or physical activity."
4020 PRINT "       Heat Index  ranges between 90 and 105 degrees indicate a"
4030 PRINT "       possibility  of  heat  cramps and  heat  exhaustion with"
4040 PRINT "       prolonged  exposure and/or physical activity."
4050 PRINT "  "
4060 PRINT "       Program calculations assume an adult, wearing long pants"
4070 PRINT "       and a  short sleeved shirt,  walking in shade at 3.1 MPH"
4080 PRINT "       with standard sea level air pressure,  a wind  speed  of"
4090 PRINT "       5.6 MPH, and a vapor pressure of 1.6kPa.  In effect, the"
4100 PRINT "       calculations  approximate the temperature  that  current"
4110 PRINT "       conditions feel like to the average person."
4120 PRINT "  "
4130 IF CLRT$ = "Y" THEN COLOR 7,0,0
4140 RETURN
4150 TC=TA
4160 IF U$="F" OR U$="f" THEN TC=(TA-32)*5/9
4170 ES=6.11*10^((7.567*TC)/(239.7+TC))
4180 E=.01*RH*ES
4190 GOTO 4230
4200 IF DF<0 THEN GOTO 4530
4210 IF U$="F" OR U$="f" THEN APPTEMP=32+1.8*APPTEMP
4220 RETURN
4230 TB=37:PB=5.65:Q=180:RS=.0387
4240 ZS=.0521:EHC=17.4:PHI2=.84
4250 R=.124:CHC=11.6:PINF=.1*E
4260 HER=4.18+.036*TC
4270 ERA=1/(EHC+HER)
4280 QV=Q*(.143-.00112*TC-.0168*PINF)
4290 EZA=.060606/EHC
4300 HR=3.35+.049*TC
4310 ARA=1/(CHC+HR)
4320 AZA=.060606/CHC
4330 Q2U=((TB-TC)+(PB-PINF)*ERA/(ZS+EZA))/(RS+ERA)
4340 QJ=(Q-QV-(1-PHI2)*Q2U)/PHI2
4350 K=(RS+ARA)+(ZS+AZA)/R-((TB-TC)+(PB-PINF)/R)/QJ
4360 L=(RS+ARA)*(ZS+AZA)
4370 L=(L-((TB-TC)*(ZS+AZA)+(PB-PINF)*ARA)/QJ)/R
4380 F=K*K-4*L
4390 IF F<0 THEN DF=-1
4400 IF F<0 THEN GOTO 4200
4410 RF=.5*(-K+SQR(F))
4420 DF=60*RF
4430 IF DF<0 THEN GOTO 4200
4440 W1=.2016
4450 W2=(1-PHI2)/(RS+ERA)
4460 W3=PHI2/(RS+RF+ARA)
4470 W4=159.0984
4480 W5=37
4490 W6=4.05*ERA/(ZS+EZA)
4500 W7=4.05*(RF+ARA)/(ZS+R*RF+AZA)
4510 APPTEMP=(-W4+W2*(W5+W6)+W3*(W5+W7))/(W1+W2+W3)
4520 GOTO 4200
4530 HC=12.3:HR=4.1+.028*TC
4540 RA=1/(HC+HR):ZA=.060606/HC
4550 QU=Q-QV
4560 FOR IT=1 TO 10
4570 ZS=((PB-PINF)*RA)/(QU*(RS+RA)-(TB-TC))-ZA
4580 IF ZS<0 THEN ZS=0
4590 R3=(ZS/600000!)^.2
4600 C=ABS(RS-R3)
4610 IF C<=.0001 THEN GOTO 4640
4620 RS=.5*(RS+R3)
4630 NEXT IT
4640 N1=159.0984:N2=37:N3=4.05*RA/(ZS+ZA)
4650 N4=(RS+RA):N5=.2016
4660 APPTEMP=(-N1+(N2+N3)/N4)/(N5+1/N4)
4670 GOTO 4210
4680 REM
4690 REM     TEMP-HUMIDITY INDEX SUBROUTINE
4700 REM
4710 CLS:IF CLRT$ = "Y" THEN COLOR 12
4720 LOCATE 2,26:PRINT "TEMPERATURE HUMIDITY INDEX"
4730 IF CLRT$ = "Y" THEN COLOR 5
4740 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
4750 IF CLRT$ = "Y" THEN COLOR 3,0,0
4760 KEY OFF:LOCATE 7,24:PRINT "THE TEMPERATURE HUMIDITY INDEX"
4770 LOCATE 8,21:PRINT "DETERMINES THE EFFECTIVE TEMPERATURE"
4780 LOCATE 11,12:INPUT "ENTER THE TEMPERATURE IN FAHRENHEIT                 ";T
4790 LOCATE 12,12:INPUT "ENTER THE RELATIVE HUMIDITY                         ";H
4800 LOCATE 15,15:PRINT "PLEASE WAIT - EFFECTIVE TEMPERATURE BEING COMPUTED"
4810 LOCATE 18,30:FOR C=1 TO 16
4820 IF CLRT$ = "Y" THEN COLOR (C):PRINT "!!!!!!!!!!!!!!!!!!!"
4830 LOCATE 18,30:C=C+1
4840 FOR Z=1 TO 400:NEXT Z
4850 NEXT C
4860 IF CLRT$ = "Y" THEN COLOR 3,0,0
4870 LOCATE 18,25:PRINT "                                   "
4880 IF H>94 THEN A=((.195*T)-15) ELSE IF H>89 AND H<95 THEN A=((.18*T)-15)
4890 IF H>79 AND H<90 THEN A=((.1667*T)-15) ELSE IF H>69 AND H<80 THEN A=((.145*T)-15)
4900 IF H>59 AND H<70 THEN A=((.1233*T)-15) ELSE IF H<60 THEN A=((.085*T)-15)
4910 TH=(((.8*T)+15)+A)
4920 IF CLRT$ = "Y" THEN COLOR 13
4930 LOCATE 20,10:PRINT "THE TEMPERATURE HUMIDITY INDEX =  ";TH;"DEGREES FAHRENHEIT"
4940 IF CLRT$ = "Y" THEN COLOR 7,0,0
4950 LOCATE 23,17:INPUT "ANOTHER TEMPERATURE HUMIDITY INDEX (Y/N)";L$
4960 IF L$="Y" OR L$="y" THEN GOTO 4710
4970 LOCATE 24,16:INPUT "View THI Explanation & Comfort Table? (Y/N)";CT$
4980 IF CT$="N" OR CT$="n" THEN GOTO 5000
4990 GOTO 5010
5000 RETURN
5010 IF CLRT$ = "Y" THEN COLOR 14,1,1
5020 CLS:PRINT "  "
5030 PRINT "    Your Temperature-Humidity Index reading was "TH"."
5040 PRINT "  "
5050 PRINT "    Readings in excess of  70  represent the point  where a few people"
5060 PRINT "    begin  to  feel  uncomfortable.   Over 75, about 1/2 of all people"
5070 PRINT "    will feel uncomfortable. Nearly all people will feel uncomfortable"
5080 PRINT "    with  readings  over  79  with rapidly  decreasing work efficiency"
5090 PRINT "    begining  with  levels  in excess of  84;  and EXTREME DANGER with"
5100 PRINT "    possibility of heat  exhaustion  and heat stroke begin with levels"
5110 PRINT "    of 92 and higher."
5120 PRINT "  "
5130 PRINT "    The THI number, used to express the  combined temperature-humidity"
5140 PRINT "    effect provides a fairly good index of equivalent heat stress.  In"
5150 PRINT "    engineering, this combined index is refered to as `effective temp-"
5160 PRINT "    erature'. The weather bureau has also been known to refer to it as"
5170 PRINT "    the Discomfort Index.  It is NOT the same as the `Heat Index' even"
5180 PRINT "    though they both help to compute `Appearant' Temperatures.
5190 PRINT "  "
5200 PRINT "  "
5210 IF CLRT$ = "Y" THEN COLOR 7,0,0
5220 RETURN
5230 REM
5240 REM     DEW POINT SUBROUTINE
5250 REM
5260 CLS:IF CLRT$ = "Y" THEN COLOR 10
5270 LOCATE 2,28:PRINT "DEW POINT CALCULATION"
5280 IF CLRT$ = "Y" THEN COLOR 5
5290 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
5300 IF CLRT$ = "Y" THEN COLOR 3,0,0
5310 KEY OFF:LOCATE 7,12
5320 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
5330 LOCATE 8,12
5340 INPUT "ENTER THE RELATIVE HUMIDITY (`50' = 50%)           ";DPRH
5350 T=(T-32)*5/9
5360 X=1-(.01*DPRH)
5370 TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14
5380 TD=(TD*9/5)+32
5390 IF CLRT$ = "Y" THEN COLOR 3
5400 LOCATE 11,19:PRINT "PLEASE WAIT - DEW POINT BEING COMPUTED"
5410 FOR ZZ=1 TO 1600:NEXT ZZ
5420 IF CLRT$ = "Y" THEN COLOR 4
5430 LOCATE 13,23:PRINT "TF=(T-32)*5/9:X=1-(.01*DPRH)"
5440 FOR Z=1 TO 800:NEXT Z
5450 LOCATE 14,9:PRINT "TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14"
5460 FOR ZXC=1 TO 800:NEXT ZXC
5470 LOCATE 15,30:PRINT "TD=(TD*9/5)+32"
5480 FOR ZX=1 TO 1600:NEXT ZX
5490 IF CLRT$ = "Y" THEN COLOR 13
5500 LOCATE 19,21:PRINT "DEW POINT CALCULATION = ";TD
5510 IF CLRT$ = "Y" THEN COLOR 7,0,0
5520 LOCATE 24,20:INPUT "CALCULATE ANOTHER DEW POINT (Y/N)";L$
5530 IF L$="Y" OR L$="y" THEN GOTO 5260
5540 RETURN
5550 REM     ~~~~~~~~~~LAST LINE OF PROGRAM~~~~~~~~~