4 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
10 'METSHOWR - Meteor Shower Predictor - 22 MAR 97 rev. 13 MAR 1999
20 CLS:KEY OFF:COLOR 7,0,1
30 IF EX$=""THEN EX$="EXIT"
40 UL$=STRING$(80,205)
50 DIM LDATE(400),LTIME(400),LELEV(400),LAZIM(400)
60 '
70 '.....start
80 CLS:COLOR 15,2
90 PRINT " METEOR SHOWER PREDICTIONS";TAB(57);;"by Michael R. Owen W9IP ";
100 PRINT STRING$(80,32);
110 LOCATE CSRLIN-1,20:PRINT "edited for HAMCALC by George Murphy VE3ERP";
120 COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
130 GOSUB 4680
140 PRINT
150 COLOR 0,7:LOCATE ,24:PRINT " Press 1 to continue or 0 to EXIT ";:COLOR 7,0
160 Z$=INKEY$:IF Z$=""THEN 160
170 IF Z$="0"THEN CLS:RUN EX$
180 IF Z$="1"THEN LOCATE CSRLIN-1:PRINT UL$;:GOTO 200
190 GOTO 160
200 IF MYLATD*MYLOND THEN 260
210 COLOR 0,7:PRINT " Define your QTH: ";:COLOR 7,0
220 PRINT " ENTER: Latitude in decimal degrees  (+ø if North, -ø if South)";
230 INPUT MYLATD:IF MYLATD<0 THEN LA$="S"ELSE LA$="N"
240 PRINT " ENTER: Longitude in decimal degrees  (+ø if East, -ø if West) ";
250 INPUT MYLOND:IF MYLOND<0 THEN LO$="W"ELSE LO$="E"
260 CLS
270 'DEF FNACOS(X)=1.570796-ATN(X/SQR(1.000000-X*X))  'arccos
280 'DEF FNARSIN(X)= ATN(X/SQR(1.000000-X*X))               'arcsin
290 '
300 '.....main menu
310 LENG=0:INCR=0:COUNTR=0:ENDER=1:BEST=0:HEADER=0:OPTDIR=0:BESEL=90
320 GOSUB 4600
330 '
340 CLS
350 PRINT " Press number in ( ) to select:"
360 PRINT UL$;
370 PRINT "  (1) Peak Time Prediction"
380 PRINT "  (2) Peak Time Prediction + Graph of AZ/EL of Radiant for a ";
390 PRINT "Particular Path"
400 PRINT "  (3) Listing of Good Times for All Paths"
410 PRINT "  (4) Best Path for a Particular Time"
420 PRINT
430 PRINT "  (0) Program Main Menu"
440 Z$=INKEY$:IF Z$=""THEN 440
450 WHICH=VAL(Z$)
460 IF WHICH<1 THEN 70
470 IF WHICH>4 THEN 440
480 IF WHICH<>2 THEN 730 ELSE 510
490 GOTO 440
500 '
510 CLS: PRINT " Press letter in ( ) to select direction from your QTH at";
520 PRINT USING "###.#ø";ABS(MYLATD);:PRINT LA$;USING "####.#ø";ABS(MYLOND);
530 PRINT LO$
540 PRINT UL$;
550 PRINT " (a) North";:PRINT ;" (b) Northeast";: PRINT ;" (c) East"
560 PRINT " (d) Southeast";: PRINT ;" (e) South";: PRINT ;" (f) Southwest"
570 PRINT " (g) West";: PRINT ;" (h) Northwest"
580 PRINT " (i) To a Specific Location"
590 PRINT " (j) Specific bearing (0ø-360ø) from your QTH"
600 Z$=INKEY$:IF Z$=""THEN 600
610 Z=ASC(Z$)
620 IF Z<97 OR Z>106 THEN 600 ELSE DIRECTION = Z-96
630 IF WHICH <>2 THEN 730
640 IF Z$="i"THEN 650 ELSE 710
650 COLOR 0,7:PRINT " Define the Specific Location: ";:COLOR 7,0
660 PRINT " ENTER: Latitude in decimal degrees  (+ø if North, -ø if South)";
670 INPUT HISLATD:IF HISLATD<0 THEN LA$="S"ELSE LA$="N"
680 PRINT " ENTER: Longitude in decimal degrees  (+ø if East, -ø if West) ";
690 INPUT HISLOND:IF HISLOND<0 THEN LO$="W"ELSE LO$="E"
700 GOSUB 3470
710 IF Z$="j"THEN INPUT " ENTER: Bearing (decimal degrees)";LOOK
720 '
730 CLS
740 PRINT  "      METEOR SHOWER"; TAB(23);;"APPROX.DATE"
750 PRINT
760 PRINT "   (1)  QUADRANTIDS ";TAB(25);"JAN  4"
770 PRINT "   (2)  LYRIDS      ";TAB(25);"APR 22"
780 PRINT "   (3)  ETA AQUARIDS";TAB(25);"MAY  4"
790 PRINT "   (4)  ARIETIDS    ";TAB(25);"JUN  7"
800 PRINT "   (5)  PERSEIDS    ";TAB(25);"AUG 12"
810 PRINT "   (6)  DRACONIDS   ";TAB(25);"OCT 10"
820 PRINT "   (7)  ORIONIDS    ";TAB(25);"OCT 20"
830 PRINT "   (8)  LEONIDS     ";TAB(25);"NOV 17"
840 PRINT "   (9)  GEMINIDS    ";TAB(25);"DEC 13"
850 PRINT
860 COLOR 0,7:PRINT " Press number in ( ) for shower information ";:COLOR 7,0
870 Z$=INKEY$:IF Z$=""THEN 870
880 SHOWER=VAL(Z$)
890 IF SHOWER <1 OR SHOWER >9 THEN 870
900 LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1
910 GOSUB 3860: IF WHICH=1 THEN 2620
920 IF WHICH=4 THEN PRINT:INPUT ;" ENTER: Time GMT (####)...";STARTTIME:CENT$="Y":GOTO 1000
930 '
940 PRINT UL$;
950 LENG=2400:INCR=60
960 STARTTIME=0
970 '* STARTTIME=0 IS AUTOMATIC
980 '* THIS LOOP "LOOKS" AROUND THE COMPASS AT 45 DEGREE INCREMENTS
990 IF WHICH<>3 THEN 1000
995  FOR DIRECTION = 1 TO 8
1000 ROUNDS=0
1010 TIME=STARTTIME
1020 TIMECOUNT=TIME
1030 FINISH=TIMECOUNT+LENG+100
1040 GOSUB 2710: T=S*15*R1
1050 IF COUNTR>0 THEN 1200
1060 '* INPUT RIGHT ASCENSION DATA: RAHOUR, RAMIN IN DATA STATEMENT.
1070 '* A$ IS HOURS, A2 IS MIN, A3 IS SEC.
1080 '* CHANGE THESE OR WRITE AN INPUT STATEMENT IF YOU WANT TO
1090 '* EVALUATE OTHER METEOR SHOWERS (OR OTHER CELESTIAL OBJECTS)
1100 A$= STR$(RAHOUR): A2=RAMIN: A3=0
1110 GOSUB 2650: R=A*15*R1
1120 '* INPUT DECLINATION, SAME COMMENTS AS ABOVE
1130 A$=STR$(DEC): A2=0: A3=0
1140 GOSUB 2650: DEG=A*R1
1150 IF WHICH<>4 THEN 1200
1160 PRINT: PRINT ;" ...PLEASE WAIT..."
1170 FOR BESTDIR=0 TO 355 STEP 5
1180 ANGLE=BESTDIR
1190 GOTO 1340
1200 IF WHICH=2 AND COUNTR=1 THEN 1370
1210 '* THIS SECTION CHOOSES PATHS IN 45 DEGREE STEPS
1220 IF DIRECTION=9 THEN GOSUB 3470:GOSUB 3010:GOTO 1400
1230 IF DIRECTION=1 THEN ANGLE=0:WAY$="North"
1240 IF DIRECTION=2 THEN ANGLE=45:WAY$="Northeast"
1250 IF DIRECTION=3 THEN ANGLE=90:WAY$="East"
1260 IF DIRECTION=4 THEN ANGLE=135:WAY$="Southeast"
1270 IF DIRECTION=5 THEN ANGLE=180:WAY$="South"
1280 IF DIRECTION=6 THEN ANGLE=225:WAY$="Southwest"
1290 IF DIRECTION=7 THEN ANGLE=270:WAY$="West"
1300 IF DIRECTION=8 THEN ANGLE=315:WAY$="Northwest"
1310 IF DIRECTION=10 THEN ANGLE=LOOK
1320 '* "RIGHT" AND "RIGHT2" ARE THE AZIMUTH OF POINTS AT
1330 '* 90 DEGREE ANGLES TO THE PATH OF INTEREST.
1340 RIGHT=(ANGLE+90) MOD 360:RIGHT2=(ANGLE+270) MOD 360
1350 IF WHICH=3 OR COUNTR=0 THEN IF ROUNDS=0 THEN GOSUB 4470
1360 IF ROUNDS=0 THEN MIDLATD=CIRLATD:MIDLOND=CIRLOND
1370 IF WHICH=2 AND COUNTR=0 THEN GOSUB 3010  'set up graph
1380 '* MIDLATD AND MIDLOND ARE THE SPOTS HALFWAY ALONG THE
1390 '* PATH OF INTEREST (THIS IS WHERE THE METEORS NEED TO BE).
1400 B=MIDLATD:L=MIDLOND
1410 B=B*R1:L=L*R1
1420 '* THIS SECTION DETERMINES THE AZ AND EL OF THE RADIANT BASED
1430 '* ON ITS R.A. AND DEC. AT PATH MIDPOINT.
1440 T5=T-R+L'LHA
1450 COSDEG=COS(DEG):SINDEG=SIN(DEG)
1460 SINB=SIN(B)
1470 S1=SINB*SINDEG
1480 COSINB=COS(B)
1490 S1=S1+COSINB*COSDEG*COS(T5)
1500 C1=1-S1*S1
1510 IF C1>0 THEN C1=SQR(C1)
1520 IF C1<=0 THEN 1540
1530 H=ATN(S1/C1):GOTO 1550
1540 H=SGN(S1)*P/2
1550 C2=(COSINB*SINDEG)-SINB*COSDEG*COS(T5)
1560 S2=-COSDEG*SIN(T5)
1570 IF C2=0 THEN A=SGN(S2)*P/2:GOTO 1600
1580 A=ATN(S2/C2)
1590 IF C2<0 THEN A=A+P
1600 IF A <0 THEN A=A+2*P
1610 ELEV=H/R1: AZIM=A/R1
1620 '* LOAD ARRAY WITH AZ, EL DATA
1630 IF WHICH<>2 THEN 1680
1640 LAZIM(ENDER)=AZIM
1650 LELEV(ENDER)=ELEV
1660 LDATE(ENDER)=DAY
1670 LTIME(ENDER)=TIME
1680 IF ELEV<0 THEN 2000
1690 QUAL=0: BEST=0
1700 '* ROUTINE TO INDICATE THE TIMES WHEN THE RADIANT IS
1710 '* WITHIN +/- 15 DEG OF PERPENDICULAR TO THE DESIRED
1720 '* PATH (GOOD) AND WHEN IT IS ALSO WITHIN +/- 15 DEG OF
1730 REM *** 45 DEG ELEVATION AT PATH MIDPOINT (BEST).
1740 TIM$=STR$(TIME):TIM$=RIGHT$(TIM$,LEN(TIM$)-1)+"z"
1750 IF LEN(TIM$)<5 THEN TIM$="0"+TIM$:GOTO 1750
1760 IF ELEV<20 AND WHICH=4 THEN 1820
1770 IF ELEV<20 THEN 1900
1780 IF (AZIM>(RIGHT-15) AND AZIM<(RIGHT+15)) OR (AZIM>(RIGHT2-15) AND AZIM<(RIGHT2+15)) THEN QUAL=1
1790 IF QUAL=1 AND ELEV>30 AND ELEV<60 THEN BEST=1
1800 IF WHICH<>4 THEN 1900
1810 IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESTEL) THEN OPTDIR=ANGLE:BESTEL=ELEV
1820 NEXT
1830 COLOR 15
1840 IF OPTDIR>1 THEN 1880
1850 PRINT: PRINT ;" No Good Directions at ";TIM$
1860 PRINT: PRINT ;" RUN OPTION 2 TO CHECK IF RADIANT IS ABOVE HORIZON"
1870 COLOR 7:GOTO 2440
1880 PRINT:PRINT ;" Best Direction at ";TIM$;;"  =";OPTDIR;;"ø"
1890 COLOR 7:GOTO 2440
1900 IF WHICH=3 THEN 1950
1910 IF QUAL=1 AND BEST=0 THEN LOCATE 23,10:PRINT "Good Time: ";TIM$
1920 COLOR 15
1930 IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESEL) THEN BESEL=ELEV:BESTIME=TIME:BESTIM$=TIM$
1940 COLOR 7
1950 IF WHICH=3 AND HEADER=0 THEN GOSUB 3210
1960 IF QUAL=1 AND BEST=0 AND WHICH=3 THEN PRINT " ";TIM$,WAY$;:GOSUB 4910
1970 COLOR 15
1980 IF BEST=1 AND WHICH=3 THEN LOCATE ,30:PRINT TIM$,WAY$;:GOSUB 4910
1990 COLOR 7
2000 IF WHICH <>2 THEN 2200
2010 IF COUNTR<>0 THEN 2080
2020 LOCATE 21,5
2030 PRINT"NORTH                        SOUTH                        NORTH"
2040 '* PLOT THE APPROXIMATE AZ, EL DATA FOR
2050 '* THE RADIANT AS A FUNCTION OF TIME.
2060 '* THE 'LOCATE' ARGUMENT IS DERIVED FROM
2070 '* INTEGER VALUES OF AZ AND EL.
2080 J=CINT(AZIM/6)+5
2090 I=CINT(20-(ELEV/5))
2100 IF I<=0 THEN I=1
2110 IF I>20 THEN I=20
2120 PNT$=STR$(INT(TIME/100))
2130 PNT$=RIGHT$(PNT$,LEN(PNT$)-1)
2140 IF LEN(PNT$)<2 THEN PNT$="0"+PNT$:GOTO 2140
2150 IF I=20 THEN 2200
2160 REM *** HIGHLIGHT BEST TIMES ON THE GRAPH
2170 IF BEST=1 THEN COLOR 15
2180 LOCATE I,J: PRINT "*";PNT$;;"z"
2190 COLOR 7
2200 TIMECOUNT=TIMECOUNT+INCR
2210 IF TIMECOUNT-(INT(TIMECOUNT/100)*100)=>60 THEN TIMECOUNT=TIMECOUNT+40
2220 TIME=TIME+INCR
2230 COUNTR=1:ENDER=ENDER+1
2240 ROUNDS=1
2250 IF TIMECOUNT<FINISH THEN 1040
2260 IF WHICH=2 AND DIRECTION<9 THEN LOCATE 23,55: PRINT WAY$;;" Path"
2270 IF WHICH=2 AND DIRECTION>8 THEN LOCATE 23,55:PRINT"Bearing";CINT(ANGLE);"ø"
2280 IF WHICH<>3 THEN 2290
2285 NEXT DIRECTION:PRINT UL$;:GOSUB 4910:GOTO 2620
2290 IF BESTIME=0 THEN 2310
2300 LOCATE 23,30: PRINT "Best Time: ";BESTIM$
2310 GOSUB 4980:CLS
2320 PRINT "                Shower: ";SHOWER$: PRINT
2330 PRINT" DAY";,;"TIME (UTC)";,;"AZIMUTH";,;"ELEVATION"
2340 FOR K=1 TO ENDER-1
2350 LD$=STR$(LDATE(K)):LD$=RIGHT$(LD$,LEN(LD$)-1)
2360 IF LEN(LD$)<2 THEN LD$="0"+LD$:GOTO 2360
2370 LT$=STR$(LTIME(K)):LT$=RIGHT$(LT$,LEN(LT$)-1)
2380 IF LEN(LT$)<4 THEN LT$="0"+LT$:GOTO 2380
2390 PRINT "  ";LD$;TAB(18);LT$;
2400 PRINT TAB(30);USING "###.#ø";LAZIM(K);
2410 PRINT TAB(44);USING "###.#ø";LELEV(K);:GOSUB 4910
2420 NEXT K
2430 PRINT UL$;
2440 GOSUB 4980:LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,24:COLOR 0,7
2450 PRINT " Press 1 to continue or 0 to quit ";:COLOR 7,0
2460 Z$=INKEY$:IF Z$=""THEN 2460
2470 IF Z$="0"THEN 340
2480 IF Z$="1"THEN COUNTR=0:ENDER=0:PRINTED=0:BESTEL=999:GOTO 300
2490 GOTO 2460
2500 '
2510 '* FROM "ASTRONOMICAL CALENDAR 1985" BY GUY OTTWELL
2520 DATA QUADRANTIDS,282.80,1,4,14 hours,41.5,110,15,28,50,B,100
2530 DATA LYRIDS,31.4,4,21,2.3 days,47,Variable,18,8,32,BC,105
2540 DATA ETA AQUARIDS,44,5,4,3 days,67,21,22,20,-1,C2,115
2550 DATA ARIETIDS,75.0,6,5,Rich but small,37,60,2,56,23,Unknown,100
2560 DATA PERSEIDS,139.3,8,11,4.6 days,60,68,3,4,58,C2,110
2570 DATA DRACONIDS, 196.3,10,10,1.2 hours,21,42,17,28,54,C1,97
2580 DATA ORIONIDS, 207,10,20,2 days,67,35,6,20,15,C2,115
2590 DATA LEONIDS, 234.7,11,16,4 days,71,40,10,8,22,C2,150
2600 DATA GEMINIDS, 261.9,12,13,2.6 days,35,58,7,28,32,B,95
2610 '
2620 '.....end
2630 GOSUB 4980:GOTO 340
2640 '
2650 '.....SEXAGESIMAL TO DECIMAL CONVERSION
2660 S=1: A1=ABS(VAL(A$))
2670 IF LEFT$(A$,1)="-" THEN S=-1
2680 A=S*(A1+A2/60+A3/3600)
2690 RETURN
2700 '
2710 '.....GREENWICH MEAN SIDERIAL TIME CONVERSION
2720 HOUR=INT(TIME/100)
2730 MIN=TIME-(HOUR*100)
2740 IF MIN=>60 THEN TIME=TIME+40:GOTO 2720
2750 IF TIME>2400 THEN TIME=TIME-2400:DAY=DAY+1
2760 HOUR=HOUR/24:MIN=MIN/1440
2770 D=DAY+HOUR+MIN
2780 D1=INT(D):F=D-D1-5.000000E-01
2790 J=-INT(7*(INT((M+9)/12)+Y)/4)
2800 S=SGN(M-9):A=ABS(M-9)
2810 J1=INT(Y+S*INT(A/7))
2820 J1=-INT((INT(J1/100)+1)*3/4)
2830 J=J+INT(275*M/9)+D1+J1
2840 J=J+1.721027E+06+2+367*Y
2850 IF F>=0 THEN 2880
2860 F=F+1:J=J-1
2870 D=J-2.451545E+06
2880 T=D/3.652500E+04:T1=INT(T)
2890 J0=T1*3.652500E+04+2.451545E+06
2900 T2=(J-J0+5.000000E-01)/3.652500E+04
2910 S=2.411054840999999E+04+1.848128659999999E+02*T1
2920 S=S+8.640184812865999E+06*T2
2930 S=S+9.310399E-02*T*T
2940 S=S-6.199999E-06*T*T*T
2950 S=S/8.640000E+04:S=S-INT(S)
2960 S=24*(S+(F-5.000000E-01)*1.002737909000000)
2970 IF S<0 THEN S=S+24
2980 IF S>24 THEN S=S-24
2990 RETURN
3000 '
3010 '.....graph diagram
3020 CLS:LOCATE 1,22:PRINT "Shower: ";SHOWER$;" (";M$;"/";D$;"/";Y$;")"
3030 LOCATE 2,13
3040 PRINT "AZ, EL OF RADIANT AT PATH MIDPOINT: ";ABS(CINT(MIDLATD));"ø";LA$;".";
3050 PRINT "   ";ABS(CINT(MIDLOND));"ø";LO$;"."
3060 FOR I=2 TO 20
3070 LOCATE I,3:PRINT (90-(I*5))+10
3080 NEXT I
3090 LOCATE 5,1 : PRINT "E";: LOCATE 6,1 : PRINT "L": LOCATE 7,1 : PRINT "E"
3100 LOCATE 8,1 : PRINT "V";: LOCATE 9,1 : PRINT "A": LOCATE 10,1: PRINT "T"
3110 LOCATE 11,1: PRINT "I";: LOCATE 12,1: PRINT "O": LOCATE 13,1: PRINT "N"
3120 '
3130 '.....set bottom axis
3140 FOR J=5 TO 65 STEP 5
3150 LOCATE 20,J-1:PRINT (J-5)*6
3160 NEXT J
3170 LOCATE 11,7:PRINT STRING$(62,"-")
3180 LOCATE 22,50:PRINT "Home QTH";ABS(MYLATD);"ø";LA$;ABS(MYLOND);"ø";LO$;"."
3190 RETURN
3200 '
3210 '.....title option 3
3220 CLS
3230 PRINT "Shower: ";SHOWER$ ;"   Date: ";M$;"/";D$;"/";Y$;"  Peak at ";ZU$;;"z"
3240 PRINT "    GOOD TIMES"
3250 COLOR 15
3260 LOCATE 2,33: PRINT "BEST TIMES"
3270 COLOR 7
3280 HEADER=1
3290 RETURN
3300 '
3310 '.....CALCULATE ECLIPTIC LONGITUDE FROM ASTR.ALMANAC
3320 JC#=CDBL(J)
3330 FC#=CDBL(F)
3340 JD#=JC#+FC#
3350 REM *** JD# IS DOUBLE-PRECISION JULIAN DAY
3360 N#=JD#-2.451545000000000E+06
3370 LONSUN#=2.804599E+02+(9.856473E-01*N#)
3380 G#=3.575280E+02+(9.856002E-01*N#)
3390 IF LONSUN#<0 THEN LONSUN#=LONSUN#+3.600000E+02
3400 IF G#<0 THEN G#=G#+3.600000E+02
3410 IF LONSUN#<0 THEN 3390
3420 IF G#<0 THEN 3400
3430 RCON#=1.800000E+02/3.141592653999999
3440 LONSUNT#=LONSUN#+(1.914999*SIN(G#/RCON#))+(1.999999E-02*SIN(2*(G#/RCON#)))
3450 RETURN
3460 '
3470 '.....bearing and distance
3480 U$="#####.#"
3490 IF DIRECTION<>9 THEN HISLATD=CIRLATD:HISLOND=CIRLOND
3500 DIFLOND=MYLOND-HISLOND
3510 MIDLATD=MYLATD-((MYLATD-HISLATD)/2)
3520 IF DIFLOND<-180 THEN DIFLOND=DIFLOND+360
3530 IF DIFLOND>180 THEN DIFLOND=DIFLOND-360
3540 '.....degrees to radians
3550 HISLAT=HISLATD*R1:HISLON=HISLOND*R1
3560 DIFLON=DIFLOND*R1
3570 '.....distance
3580 COSB=(SMYLAT*SIN(HISLAT))+(CMYLAT*COS(HISLAT)*COS(DIFLON))
3590 BETA=ACOS(COSB)
3600 BETA2=BETA/R1
3610 '.....factor 69.05 for stat.mi., 111.2 for km
3620 DIST=BETA2*6.905000E+01
3630 '.....bearing
3640 COSA=(SIN(HISLAT)-(SMYLAT*COSB))/(CMYLAT*SIN(BETA))
3650 '.....corect round-off errors
3660 IF COSA>1.000000 THEN COSA=1.000000
3670 IF COSA<-1.000000 THEN COSA=-1.000000
3680 AZ=ACOS(COSA)
3690 ANGLE=AZ/R1
3700 '* HAFLON IS THE LON OF A POINT BETWEEN HERE AND THERE
3710 HAF=CMYLAT*COS(MIDLATD*R1)
3720 HAFLON=ACOS((COS(BETA/2)-(SMYLAT*SIN(MIDLATD*R1)))/HAF)
3730 IF DIFLOND>0 THEN ANGLE=3.600000E+02-ANGLE
3740 IF DIRECTION<>9 OR PRINTED=1 OR WHICH<>2 THEN 3810
3750 PRINT:PRINT ;" Distance=";USING U$;DIST;
3760 PRINT " stat.miles (";USING U$;BETA2*1.111999E+02;
3770 PRINT "km):   Bearing=";USING U$;ANGLE;:PRINT "ø"
3780 COLOR 0,7:PRINT " Press any key to continue ";:COLOR 7,0
3790 IF INKEY$=""THEN 3790
3800 PRINTED=1
3810 IF ANGLE>180 THEN HAFLON=MYLON-HAFLON ELSE HAFLON=MYLON+HAFLON
3820 MIDLOND=HAFLON/R1
3830 RETURN
3840 '
3850 '.....READ DATA AND CALCULATE PEAK DATE/TIME
3860 FOR I=1 TO SHOWER
3870 READ SHOWER$,ELON,M,DAY,DURATION$,VELOCITY$
3880 READ RATE$,RAHOUR,RAMIN,DEC,CLASS$,HEIGHT
3890 NEXT I
3900 RESTORE
3910 COLOR 0,7:INPUT " ENTER: Year....";Y
3920 LOCATE CSRLIN-1:PRINT ".....ITERATION ON PROGRESS - PLEASE WAIT....."
3930 TIME=0
3940 COLOR 7,0:GOSUB 2710
3950 GOSUB 3310
3960 IF LONSUNT#>ELON THEN 4010
3970 DAY=DAY+1
3980 GOSUB 2710
3990 GOSUB 3310
4000 GOTO 3960
4010 IF LONSUNT#<=ELON THEN 4060
4020 E2=LONSUNT#
4030 DAY=DAY-1
4040 GOSUB 2710
4050 GOSUB 3310
4060 T=24*((ELON-LONSUNT#)/(E2-LONSUNT#))
4070 H0=INT(T)
4080 M1=INT(60*(T-H0)+5.000000E-01)
4090 GMT=100*H0+M1
4100 IF GMT<0 THEN DAY=DAY-1: GOTO 3940
4110 IF DAY<=31 THEN 4140
4120 DAY=DAY-31
4130 M=M+1
4140 CLS:LOCATE 2
4150 ZU$=STR$(GMT):ZU$=RIGHT$(ZU$,LEN(ZU$)-1)
4160 IF LEN(ZU$)<4 THEN ZU$="0"+ZU$:GOTO 4160
4170 M$=STR$(M):IF VAL(M$)<10 THEN M$=" 0"+RIGHT$(M$,1)
4180 D$=STR$(DAY):IF VAL(D$)<10 THEN D$=" 0"+RIGHT$(D$,1)
4190 M$=RIGHT$(M$,2):D$=RIGHT$(D$,2):Y$=RIGHT$(STR$(Y),4):
4200 PRINT " The";:COLOR 0,7:PRINT "Ý";SHOWER$;"Þ";:COLOR 7,0
4210 PRINT "meteor shower will peak at ";ZU$;" UTC on ";
4220 PRINT M$;"/";D$;"/";Y$;" (mo/da/yr)"
4230 IF WHICH>1 THEN 920
4240 PRINT UL$;
4250 PRINT " Duration above Quarter Max.... ";DURATION$
4260 PRINT " Velocity...................... ";VELOCITY$;" km/sec"
4270 PRINT " Average Height of Ionization.. ";HEIGHT;"km"
4280 PRINT " Meteors per hour (approx.).... ";RATE$
4290 PRINT " E.L. used for calculation..... ";ELON;"ø  (Epoch 2000.0)"
4300 PRINT " R.A. of Radiant............... ";RAHOUR;"hr";RAMIN;;"min"
4310 PRINT " Declination................... ";DEC;"ø"
4320 PRINT " Ceplecha's Class.............. ";CLASS$
4330 TIME=GMT:GOSUB 2710:GOSUB 3310:ROUNDLON=INT(LONSUNT#*1000)/1000
4340 PRINT
4350 PRINT "  (the E.L.values below are for checking the";
4360 PRINT "  calculated E.L. against the Nautical Almanac)"
4370 PRINT
4380 PRINT " E.L. at ";ZU$;" UTC =";USING "####.###";ROUNDLON;:PRINT "ø"
4390 TIME=0: GOSUB 2710: GOSUB 3310: ROUNDLON=INT(LONSUNT#*1000)/1000
4400 DEGLON=INT(LONSUNT#): MINLON=INT((LONSUNT#-DEGLON)*60)
4410 SECLON=(INT((((LONSUNT#-DEGLON)*60)-MINLON)*60)*100)/100
4420 PRINT " E.L. at 0000 UTC =";USING "####.###";ROUNDLON;:PRINT "ø (";
4430 PRINT DEGLON;;"ø";MINLON;;"'";SECLON;CHR$(34);;" )"
4440 GOTO 2620
4450 '
4460 '.....CALCULATE LAT, LON OF A 500-MI RADIUS CIRCLE (PATH MIDPOINT)
4470 COSA2=COS(ANGLE*R1): 'ANGLE IS THE BEARING FROM YOUR QTH
4480 '* CIRLATD IS THE LATITUDE OF THE POINT
4490 CIRLAT=ARSIN ((COSA2*CMYLAT*SINBETA2)+(SMYLAT*COSBETA2))
4500 CIRLATD=CIRLAT/R1
4510 '* CIRLOND IS THE LONGITUDE OF THE POINT
4520 CIRLON= (COSBETA2-(SMYLAT*SIN(CIRLAT)))/(CMYLAT*COS(CIRLAT))
4530 IF CIRLON>1 THEN CIRLON=1.000000
4540 IF CIRLON<-1 THEN CIRLON=-1.000000
4550 CIRLON=ACOS(CIRLON)
4560 IF ANGLE>180 THEN CIRLON=MYLON-CIRLON ELSE CIRLON=MYLON+CIRLON
4570 CIRLOND=CIRLON/R1
4580 RETURN
4590 '
4600 '.....initialize variables
4610 P=3.141592:R1=P/180
4620 MYLON=MYLOND*R1:MYLAT=MYLATD*R1
4630 CMYLAT=COS(MYLAT):SMYLAT=SIN(MYLAT)
4640 CIRRANGE=500:CIRBETA2=(CIRRANGE/6.905000E+01)*R1: 'FOR KM CHANGE 69.05 TO 111.2
4650 COSBETA2=COS(CIRBETA2):SINBETA2=SIN(CIRBETA2)
4660 RETURN
4670 '
4680 '.....preface
4690 TB=7
4700 PRINT TAB(TB);
4710 PRINT "This program calculates the peak time for major meteor showers."
4720 PRINT TAB(TB);
4730 PRINT "It also provides information concerning the optimum times for"
4740 PRINT TAB(TB);
4750 PRINT "particular paths in graphic and tabular form. The program is an"
4760 PRINT TAB(TB);
4770 PRINT "edited version of an original program by Michael R. Owen, W9IP,"
4780 PRINT TAB(TB);
4790 PRINT "and other programs by Russ Wicker, W4WD, and Joe Reisert, W1JR."
4800 PRINT
4810 PRINT TAB(TB);
4820 PRINT "References:"
4830 PRINT TAB(TB);
4840 PRINT "Astronomical Calendar 1985, by G.Ottwell, Furman U., Greenville SC."
4850 PRINT TAB(TB);
4860 PRINT "Astronomical Almanac for 1985, page C24.";
4870 PRINT TAB(TB);
4880 PRINT "The 1997 ARRL Handbook for Radio Amateurs, page 21.13."
4890 RETURN
4900 '
4910 '.....end of page
4920 LN=CSRLIN
4930 IF LN<24 THEN PRINT " ";:GOTO 4960
4940 GOSUB 4980:GOTO 4950
4950 CLS
4960 RETURN
4970 '
4980 'PRT
4990 KEY OFF:GOSUB 5060:LOCATE 25,5:COLOR 0,2
5000 PRINT " Send this page to:(1)Printer Queue? (2)Printout? ";
5010 PRINT "(3)Next page? (1/2/3)";:COLOR 7,0
5020 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 5020 ELSE GOSUB 5060
5030 IF Z$="3"THEN RETURN
5040 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
5050 IF Z$="2"THEN LPRINT CHR$(12) ELSE 4990
5060 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
FUNCTION ACOS(X)
ACOS = 1.570796-ATN(X/SQR(1.000000-X*X))  'arccos
END FUNCTION
FUNCTION ARSIN(X)
ARSIN = ATN(X/SQR(1.000000-X*X))               'arcsin
END FUNCTION