100 REM *****************ECLIPSE.BAS********************** 110 REM * * 120 REM * Lunar/Solar Eclipse Predictor - Copyright * 130 REM * 1984 by Mark Whiteman. Written in BASIC * 140 REM * Version 5.20 on a CP/M-80 2.22 system. * 150 REM * Published in ASTRONOMY - November 1986. * 160 REM * * 170 REM ************************************************** 172 REM times are emphemeris times subtract 6 hrs to get central std. time 180 REM function to put angle x in 0-360 range 190 DEF FN LESS(X)=((X/360)-FIX(X/360))*360 200 DIM TI%(14),UR(5),SD(5) 210 REM ra=pi/180. used to convert degrees to radians 220 RA=.0174532925# 230 PRINT :PRINT :PRINT 240 REM call input subroutine 250 GOSUB 2360 260 REM call day of year subroutine. put in 'do' 270 GOSUB 2550 280 Y2=Y%+(DO%/365) 290 REM calculate k lunations since 1/1/1900 300 K=(Y2-1900)*12.3685 310 K3=ABS(K-FIX(K)) 320 IF K<0 THEN K3=K3+1 330 REM see if we should round up or back a lunation 340 IF (K3>.5) AND (LS$="S") THEN K=K+.5*SGN(K) 350 REM if lunar - add 1/2 lunation to k 360 REM if k<0 we must subtract 1/2 lunation 370 IF LS$="L" THEN K2=.5 ELSE K2=0 380 K=FIX(K)+K2*SGN(K) 390 T=K/1236.85 400 REM calculate mean anomaly sun, moon, arg of latitude 410 REM and multiply by ra to get radian measure 420 SM=359.2242#+29.10535608000003#*K-.0000333*T^2-3.47E-06*T^3 430 SM=FN LESS(SM) 440 SM=SM*RA 450 MM=306.0253#+385.81691806#*K+.0107306*T^2+1.236E-05*T^3 460 MM= FN LESS(MM) 470 MM=MM*RA 480 FM=21.2964#+390.67050646#*K-.0016528*T^2-2.39E-06*T^3 490 FM=FN LESS(FM) 500 FM=FM*RA 510 REM calculate julian date of possible eclipse moon 520 REM jw=whole number part of julian day 530 REM jd=decimal part of julian day 540 JD=.75933+.53058868#*K+.0001178*T^2-1.55E-07*T^3 550 JD=JD+.00033*SIN((166.56+132.87*T-.009173*T^2)*RA) 560 REM rem if eclipse lunar - add .5 for 1/2 lunation 570 IF LS$="L" THEN JD=JD+.5 580 JW=FIX(2.41502E+06+29*K) 590 REM calculate jd correction to obtain max eclipse jd 600 MX=(.1734-.000393*T)*SIN(SM)+.0021*SIN(2*SM) 610 MX=MX-.4068*SIN(MM)+.0161*SIN(2*MM) 620 MX=MX-.0051*SIN(SM+MM)-.0074*SIN(SM-MM) 630 MX=MX-.0104*SIN(2*FM) 640 JD=JD+MX 650 JW=JW+FIX(JD) 660 JD=JD-FIX(JD) 670 REM call jd-to-calendar routine 680 GOSUB 2670 690 REM see if eclipse on this date 700 TE=ABS(SIN(FM)) 710 REM if no eclipse, print message and try next lunation 720 IF TE>.36 THEN GOSUB 2300 ELSE 770 730 K=K+BF 740 GOTO 390 750 REM eclipse is now likely 760 REM calculate lunar radii 770 S1=5.19595-.0048*COS(SM)+.002*COS(2*SM) 780 S1=S1-.3283*COS(MM)-.006*COS(SM+MM) 790 S1=S1+.0041*COS(SM-MM) 800 C1=.207*SIN(SM)+.0024*SIN(2*SM)-.039*SIN(MM) 810 C1=C1+.0115*SIN(2*MM)-.0073*SIN(SM+MM) 820 C1=C1-.0067*SIN(SM-MM)+.0117*SIN(2*FM) 830 REM calc least dist. of shadow axis gy 840 GY=S1*SIN(FM)+C1*COS(FM) 850 G1=ABS(GY) 860 REM calc radius of umbral cone 870 MU=.0059+.0046*COS(SM)-.0182*COS(MM) 880 MU=MU+.0004*COS(2*MM)-.0005*COS(SM+MM) 890 REM calc semidurations of eclipse phases 900 REM ur(0-2) are for lunar, ur(3-4) are for solar 910 NT=.5458+.04*COS(MM) 920 UR(0)=1.5572+MU :UR(1)=1.0129-MU :UR(2)=.4679-MU 930 UR(3)=1.572+MU :UR(4)=1.026-MU 940 REM calc eclipse magnitudes - lunar + solar 950 REM mg=solar pm=penumbral um=lunar umbral 960 MG=(1.5432+MU-G1)/(.546+2*MU) 970 PM=(1.5572+MU-G1)/.545 980 UM=(1.0129-MU-G1)/.545 990 REM calc node of eclipse (ascending or descending) 1000 ND=COS(FM) 1010 IF ND<0 THEN ND$="Descending" ELSE ND$="Ascending" 1020 REM see if moon passes n or s of earth shadow axis 1030 IF GY<0 THEN NS$="South" ELSE NS$="North" 1040 REM see if eclipse is lunar 1050 IF (LS$="L") AND (PM>=0) THEN GOSUB 1580 ELSE 1090 1060 GOSUB 1960 1070 GOTO 1230 1080 REM second check for lunar eclipse 1090 IF (LS$="L") AND (PM<0) THEN GOSUB 2300 :GOTO 1310 1100 REM calc circumstance of solar eclipse 1110 REM second chk for solar eclipse 1120 IF G1>1.5432+MU THEN GOSUB 2300 :GOTO 1310 1130 REM chk to see if eclipse central 1140 IF G1<.9972 THEN II%=0 ELSE 1190 1150 GOSUB 1350 1160 GOSUB 1960 1170 GOTO 1230 1180 REM chk to see if eclipse is non-central 1190 T2=1.5432+MU 1200 IF (G1>.9972) AND (G1ontinue, nd program, enu";D$ 1250 D$=CHR$(ASC(D$) AND 223) 1260 IF D$="C" THEN 1310 1270 IF D$="E" THEN 1320 1280 IF D$="M" THEN 230 1290 GOTO 1230 1300 REM increase k to next lunation and cont. search 1310 K=K+BF :GOTO 390 1320 END 1330 REM calc total/annular eclipses 1340 REM chk ii% 0=n/central 1=central 1350 U1=MG 1360 IF II%=1 THEN N%=0 ELSE N%=1 1370 IF MU<0 THEN T1$="Total Solar" :GOTO 1440 1380 IF MU>.0047 THEN T1$="Annular Solar" :GOTO 1440 1390 REM chk to see if eclipse is a/t or annular 1400 W=ATN(GY/SQR(ABS(-GY*GY+1))) 1410 OM=.00464*COS(W) 1420 IF MU=OM THEN T1$="Annular Solar" 1440 SC%=3 :GOSUB 1760 1450 RETURN 1460 REM calc non-central & partial solar eclipse 1470 U1=MG 1480 T3=.9972+ABS(MU) 1490 IF (G1>.9972) AND (G1T3 THEN T1$="Partial Solar" 1510 N%=0 :SC%=3 1520 GOSUB 1760 1530 REM nc is non-central 1540 T1$=T1$+" (nc)" 1550 RETURN 1560 REM calc circumstances of lunar eclipse 1570 REM um<0 - penumbral eclipse 1580 SC%=0 1590 IF UM<0 THEN 1700 1600 IF UM>=1 THEN T1$="Total Lunar" ELSE GOTO 1650 1610 N%=2 1620 U1=UM 1630 GOSUB 1760 1640 GOTO 1730 1650 T1$="Partial Lunar" 1660 N%=1 1670 U1=UM 1680 GOSUB 1760 1690 GOTO 1730 1700 T1$="Penumbral Lunar" 1710 U1=PM 1720 N%=0 :GOSUB 1760 1730 RETURN 1740 REM calc phase times in hrs and mins 1750 REM sd(i)=times in dec. hrs 1760 FOR I%=0 TO N% 1770 SD(I%)=SQR(UR(I%+SC%)^2-GY^2)/NT 1780 NEXT I% 1790 REM calc phase times in hrs, mins 1800 FOR I%=0 TO N% 1810 GS%=4*I% 1820 TI%(GS%)=INT(((H2-SD(I%))-INT(H2-SD(I%)))*60) 1830 TI%(GS%+1)=INT(H2-SD(I%)) 1840 TI%(GS%+2)=INT(((H2+SD(I%))-INT(H2+SD(I%)))*60) 1850 TI%(GS%+3)=INT(H2+SD(I%)) 1860 NEXT I% 1870 REM put times in 0-24 hr range 1880 FOR I%=1 TO 11 STEP 2 1890 IF TI%(I%)>=24 THEN TI%(I%)=TI%(I%)-24 1900 IF TI%(I%)<0 THEN TI%(I%)=TI%(I%)+24 1910 NEXT I% 1920 RETURN 1930 REM ******************************************* 1940 REM ****** print eclipse data subroutine ****** 1950 REM ******************************************* 1960 PRINT :PRINT :PRINT 1970 PRINT TAB(20)"Eclipse Event Summary" 1980 PRINT USING"Date of Eclipse ##/##/####";D1%;D2%;D3% 1990 PRINT "Type of Eclipse ";T1$ 2000 PRINT "Moon is at ";ND$;" Node" 2010 IF L$<>"L" THEN 2030 2020 PRINT "Moon passes ";NS$;" of Earth's shadow axis" 2030 PRINT USING"Eclipse Magnitude #.##";U1 2040 PRINT:PRINT TAB(20)"Phase Times of Eclipse" 2050 IF LS$="S" THEN GOSUB 2190 ELSE GOSUB 2080 2060 RETURN 2070 REM print lunar eclipse phase times 2080 PRINT USING"Moon Enters Penumbra ##:## ET";TI%(1),TI%(0) 2090 IF N%=0 THEN GOSUB 2270 :GOTO 2160 2100 PRINT USING"Moon Enters Umbra ##:## ET";TI%(5);TI%(4) 2110 IF N%=1 THEN GOSUB 2270 :GOTO 2150 2120 PRINT USING"Totality Begins ##:## ET";TI%(9);TI%(8) 2130 GOSUB 2270 2140 PRINT USING"Totality Ends ##:## ET";TI%(11);TI%(10) 2150 PRINT USING"Moon Leaves Umbra ##:## ET";TI%(7);TI%(6) 2160 PRINT USING"Moon Leaves Penumbra ##:## ET";TI%(3);TI%(2) 2170 RETURN 2180 REM print solar eclipse phase times 2190 PRINT USING"Eclipse Begins ##:## ET";TI%(1);TI%(0) 2200 IF N%=0 THEN GOSUB 2270 :GOTO 2240 2210 PRINT USING"Central Eclipse Begins ##:## ET";TI%(5);TI%(4) 2220 GOSUB 2270 2230 PRINT USING"Central Eclipse Ends ##:## ET";TI%(7);TI%(6) 2240 PRINT USING"Eclipse Ends ##:## ET";TI%(3);TI%(2) 2250 RETURN 2260 REM print time of maximum eclipse 2270 PRINT USING"Maximum Eclipse ##:## ET";TI%(13);TI%(14) 2280 RETURN 2290 REM sorry !, no eclipse today 2300 PRINT 2310 PRINT USING"There is no eclipse on ##/##/####";D1%;D2%;D3% 2320 RETURN 2330 REM ****************************************** 2340 REM ******** data entry subroutine *********** 2350 REM ****************************************** 2360 PRINT 2370 INPUT"Enter the Year :";Y% 2380 INPUT"Enter the Month :";M% 2390 IF (M%<1) OR (M%>12) THEN 2380 2400 INPUT"Enter the Day :";D% 2410 IF (D%<1) OR (D%>31) THEN 2400 2420 IF (M%=2) AND (D%>29) THEN 2400 2430 INPUT "Do you want a unar or olar eclipse :";LS$ 2440 LS$=CHR$(ASC(LS$) AND 223) 2450 IF (LS$<>"L") AND (LS$<>"S") THEN 2430 2460 INPUT"Search orward or ackward in time :";BF$ 2470 BF$=CHR$(ASC(BF$) AND 223) 2480 IF BF$="F" THEN BF=1 :GOTO 2510 2490 IF BF$="B" THEN BF=-1 :GOTO 2510 2500 GOTO 2460 2510 RETURN 2520 REM ******************************************** 2530 REM ******** day of year subroutine ************ 2540 REM ******************************************** 2550 LY%=0 2560 A2=Y%/4-INT(Y%/4) 2570 B2=Y%/100-INT(Y%/100) 2580 C2=Y%/400-INT(Y%/400) 2590 IF (A2=0) AND (B2<>0) THEN LY%=1 2600 IF C2=0 THEN LY%=1 2610 IF LY%=0 THEN DO%=INT((275*M%)/9)-2*INT((M%+9)/12)+D%-30 2620 IF LY%=1 THEN DO%=INT((275*M%)/9)-INT((M%+9)/12)+D%-30 2630 RETURN 2640 REM ****************************************** 2650 REM ****** jd to calendar date subroutine **** 2660 REM ****************************************** 2670 JD=JD+.5 2680 IF JD>=1 THEN JW=JW+1 :JD=JD-1 2690 Z=FIX(JW) 2700 F=JD 2710 AL%=FIX((Z-1867216.25#)/36524.25#) 2720 A=Z+1+AL%-FIX(AL%/4) 2730 IF Z<2.29916E+06 THEN A=Z 2740 B=A+1524 2750 C%=FIX((B-122.1)/365.25) 2760 DC=FIX(365.25*C%) 2770 E%=FIX((B-DC)/30.6001) 2780 DA=B-DC-FIX(30.6001*E%)+F 2790 IF E%<13.5 THEN E%=E%-1 2800 IF E%>13.5 THEN E%=E%-13 2810 IF E%>2.5 THEN C%=C%-4716 2820 IF E%<2.5 THEN C%=C%-4715 2830 D2%=FIX(DA) 2840 D1%=E% 2850 D3%=C% 2860 H2=(DA-FIX(DA))*24 2870 TI%(13)=INT(H2) 2880 TI%(14)=INT((H2-FIX(H2))*60) 2890 RETURN