bwBASIC/B15B/lunar.bas

10 REM    NEW AND FULL MOONS
12 REM
14 REM
16 R1=3.14159265/180: U=0
18 INPUT "YEAR ";Y
19 G=1: IF Y<1583 THEN G=0
20 PRINT
22 K0=INT((Y-1900)*12.3685)
24 T=(Y-1899.5)/100
26 T2=T*T: T3=T*T*T
28 J0=2415020+29*K0
30 F0=0.0001178*T2-0.000000155*T3
32 F0=F0+0.75933+0.53058868*K0
34 F0=F0-0.000837*T-0.000335*T2
36 J0=J0+INT(F0): F0=F0-INT(F0)
38 M0=K0*0.08084821133
40 M0=360*(M0-INT(M0))+359.2242
42 M0=M0-0.0000333*T2
44 M0=M0-0.00000347*T3
46 M1=K0*0.07171366128
48 M1=360*(M1-INT(M1))+306.0253
50 M1=M1+0.0107306*T2
52 M1=M1+0.00001236*T3
54 B1=K0*0.08519585128
56 B1=360*(B1-INT(B1))+21.2964
58 B1=B1-0.0016528*T2
60 B1=B1-0.00000239*T3
62 FOR K9=1 TO 27 STEP 2
64 J=J0+14*K9: F=F0+0.765294*K9
66 K=K9/2
68 M5=(M0+K*29.10535608)*R1
69 M6=(M1+K*385.81691806)*R1
70 B6=(B1+K*390.67050646)*R1
71 F=F-0.4068*SIN(M6)
72 F=F+(0.1734-0.000393*T)*SIN(M5)
73 F=F+0.0161*SIN(2*M6)
74 F=F-0.0104*SIN(2*B6)
75 F=F-0.0074*SIN(M5-M6)
76 F=F-0.0051*SIN(M5+M6)
77 F=F+0.0021*SIN(2*M5)
81 F=F+0.5/1440
82 J=J+INT(F): F=F-INT(F)
86 GOSUB 100
92 NEXT
94 GO TO 999
100 REM  LUNAR ECLIPSE SUBROUTINE
102 D7=0
104 IF ABS(SIN(B6))>0.36 THEN 196  
106 S=5.19595-0.0048*COS(M5)
108 S=S+0.0020*COS(2*M5)
110 S=S-0.3283*COS(M6)
112 S=S-0.0060*COS(M5+M6)
114 S=S+0.0041*COS(M5-M6)
116 C1=0.2070*SIN(M5)
118 C1=C1+0.0024*SIN(2*M5)
120 C1=C1-0.0390*SIN(M6)
122 C1=C1+0.0115*SIN(2*M6)
124 C1=C1-0.0073*SIN(M5+M6)
126 C1=C1-0.0067*SIN(M5-M6)
128 C1=C1+0.0117*SIN(2*B6)
130 D9=ABS(S*SIN(B6)+C1*COS(B6))
132 U=0.0059+0.0046*COS(M5)
134 U=U-0.0182*COS(M6)
136 U=U+0.0004*COS(2*M6)
138 U=U-0.0005*COS(M5+M6)
140 RP=1.2847+U: RU=0.7404-U
142 MP=(1.5572+U-D9)/0.545
144 IF MP<0 THEN 196  
146 MU=(1.0129-U-D9)/0.545
148 D5=1.5572+U: D6=1.0129-U
150 D7=0.4679-U
152 N=(0.5458+0.04*COS(M6))/60
154 D5=SQR(D5*D5-D9*D9)/N
156 IF MU<=0 THEN 164  
158 D6=SQR(D6*D6-D9*D9)/N
160 IF MU<=1 THEN 164  
162 D7=SQR(D7*D7-D9*D9)/N
164 GOSUB 900: PRINT
166 PRINT "ECLIPSE DATE: ";Y;M;D1
168 PRINT " MAXIMUM PHASE: ";
170 PRINT H1;"h ";M9;"m UT"
172 MP=INT(1000*MP+0.5)/1000
174 PRINT " PENUMBRAL MAG: ";MP
176 IF MU<=0 THEN 182  
178 MU=INT(1000*MU+0.5)/1000
180 PRINT " UMBRAL MAG:     ";MU
182 PRINT " SEMIDURATIONS --"
184 D5=INT(D5+0.5): REM ROUND OFF
186 PRINT "   PENUMBRA: ";D5;"m"
188 IF MU<0 THEN 196  
190 D6=INT(D6+0.5): D7=INT(D7+0.5)
192 PRINT "   UMBRA:    ";D6;"m"
194 PRINT "   TOTALITY: ";D7;"m"
196 RETURN
900 REM   JD --> CALENDAR
905 REM
920 F=F+0.5
925 IF F<1 THEN 935  
930 F=F-1: J=J+1
935 IF G=1 THEN 945  
940 A=J: GOTO 955  
945 A1=INT((J/36524.25)-51.12264)
950 A=J+1+A1-INT(A1/4)
955 B=A+1524
960 C=INT((B/365.25)-0.3343)
965 D=INT(365.25*C)
970 E=INT((B-D)/30.61)
975 D=B-D-INT(30.61*E)+F
980 M=E-1: Y=C-4716
985 IF E>13.5 THEN M=M-12
990 IF M<2.5 THEN Y=Y+1
993 D1=INT(D): H=24*(D-D1)
994 H1=INT(H): M9=INT(60*(H-H1))
997 RETURN
999 END
1000 REM ***********************
1001 REM  THIS IS THE *COMPLETE*
1002 REM  PROGRAM FOR PREDICTING
1003 REM  LUNAR ECLIPSES (SEE 
1004 REM  SKY & TELESCOPE, JUNE,
1005 REM  1988, PAGE 640)
1006 REM ***********************