90  REM  ********** HP TIME-SHARED BASIC PROGRAM LIBRARY *****************
91  REM
92  REM                     SUNSET
93  REM
94  REM   36180  REV  A          3/72
95  REM
96  REM  ************** CONTRIBUTED PROGRAM ******************************
97  REM
99  REM
100  REM SUNRISE AND SUNSET COMPUTED FOR ANY STATION
105  REM DATA (DAY,MONTH) MAY BE PUT AT 9000+
106  REM END DATA BLOCK WITH PAIR 99,99.
110  DATA 317.5,348.5,377.5,408.5,438.5,469.5
120  DATA 499.5,530.5,561.5,591.5,622.5,652.5
130  DATA 6.65028,8.6875,10.5931,12.63,14.6011,16.6383
140  DATA 18.6097,20.6467,22.6836,.655,2.69194,4.66306
160  DATA 108,102,96,90.8333,108,102,96,90.8333
170  DIM J[12],V[8],U[8],S[12],B[2]
172  LET C=3.14159/180
174  FOR K9=1 TO 12
176  READ J[K9]
178  NEXT K9
180  FOR K9=1 TO 12
182  READ S[K9]
184  NEXT K9
186  FOR K9=1 TO 8
188  READ V[K9]
190  LET V[K9]=V[K9]*C
192  NEXT K9
193  LET Z=5
194  LET L3=39.1849
195  LET L4=84.329
200  READ D,M
201  IF D#99 THEN 204
202  STOP 
204  IF D#9999 THEN 213
208  PRINT "INPUT DAY AND MONTH";
210  INPUT D,M
211  PRINT 
212  PRINT 
213  PRINT "     TWILIGHT PHENOMENA FOR WEEK OF ";
216  IF M#1 THEN 218
217  PRINT "JAN";
218  IF M#2 THEN 220
219  PRINT "FEB";
220  IF M#3 THEN 222
221  PRINT "MAR";
222  IF M#4 THEN 224
223  PRINT "APR";
224  IF M#5 THEN 226
225  PRINT "MAY";
226  IF M#6 THEN 228
227  PRINT "JUN";
228  IF M#7 THEN 230
229  PRINT "JUL";
230  IF M#8 THEN 232
231  PRINT "AUG";
232  IF M#9 THEN 234
233  PRINT "SEP";
234  IF M#10 THEN 236
235  PRINT "OCT";
236  IF M#11 THEN 238
237  PRINT "NOV";
238  IF M#12 THEN 240
239  PRINT "DEC";
240  PRINT D;"TO";D+6
241  PRINT 
242  PRINT "FOR STATION LATITUDE ";L3;"AND LONGITUDE ";L4;"DEGREES"
243  PRINT "IN TIME ZONE ";Z
245  PRINT 
250  PRINT TAB(9);"ASTRONOMICAL  NAUTICAL    CIVIL      ";
260  PRINT "RISE/SET     AZIMUTH"
300  PRINT TAB(11);"HR   MIN    HR   MIN    HR   MIN    HR   MIN";
310  PRINT "    DEGREES"
1000  DEF FNB()=ATN(SQR(1-^2)/)
1010  DEF FNA()=ATN(/SQR(1-^2))
1049  LET P=3.14159
1052  LET L1=L3*C
1054  LET L2=L4*C
1056  LET S3=236.55/3600*15*C
1060  LET G=282.442+180
1070  LET R=.985647
1080  LET E=.0167213
1090  LET E2=E^2/2
1115  LET T=319.679
1132  PRINT "SUN"
1134  GOSUB 1170
1136  PRINT "MON"
1138  GOSUB 1170
1140  PRINT "TUE"
1142  GOSUB 1170
1144  PRINT "WED"
1146  GOSUB 1170
1148  PRINT "THUR"
1150  GOSUB 1170
1152  PRINT "FRI"
1154  GOSUB 1170
1156  PRINT "SAT"
1158  GOSUB 1170
1160  FOR K9=1 TO 30
1162  PRINT 
1163  NEXT K9
1164  READ D,M
1165  IF D#9999 THEN 201
1166  RESTORE 
1167  GOTO 100
1169  REM DETERMINE TIME FOR CHOSEN ZENITH ANGLE
1170  LET J1=J[M]+D-1
1172  LET S0=S[M]*15*C+(D-1)*S3
1173  LET J2=J1
1176  LET K1=1
1178  GOSUB 4010
1179  LET R4=A
1180  FOR N=1 TO 8
1190  FOR M1=1 TO 3
1200  LET C2=-TAN(L1)*TAN(D2)+1/COS(L1)/COS(D2)*COS(V[N])
1202  IF ABS(C2)<1 THEN 1222
1204  LET U[N]=99
1206  GOTO 1350
1222  IF C2 >= 0 THEN 1230
1224  LET H=FNB(C2)+P
1226  GOTO 1240
1230  LET H=FNB(C2)
1240  IF N>4 THEN 1270
1250  LET H=-1*ABS(H)
1260  GOTO 1290
1270  LET H=ABS(H)
1290  LET S4=H+R4
1300  LET T3=(S4-S0+L2)/(1+S3/6.28319)
1310  LET J1=J2+T3/24
1320  GOSUB 4010
1322  LET R4=A
1330  NEXT M1
1340  LET U[N]=T3/C/15-42/3600
1350  IF N=4 OR N=8 THEN 1356
1355  GOTO 1450
1356  IF U[N]#99 THEN 1360
1357  LET B[K1]=999
1358  GOTO 1395
1360  LET Y=-COS(D2)*SIN(H)/COS(P/2-V[N])
1370  LET X=(SIN(D2)*COS(L1)-COS(D2)*COS(H)*SIN(L1))/COS(P/2-V[N])
1380  GOSUB 8000
1390  LET B[K1]=A/C
1395  LET K1=K1+1
1450  NEXT N
1455  LET D=D+1
1465  GOSUB 6000
1470  RETURN 
4000  REM SOLVE KEPLER'S EQN
4010  LET R1=R*(J1-T)*C
4020  LET E3=R1+E*SIN(R1)+E2*SIN(2*R1)
4030  LET R2=E3-E*SIN(E3)
4040  LET D1=(R1-R2)/(1-E*COS(E3))
4050  LET E3=E3+D1
4060  IF ABS(D1) <= .00001 THEN 4080
4070  GOTO 4030
4080  LET R3=1-E*COS(E3)
4090  LET T2=SQR((1+E)/(1-E))*TAN(E3/2)
4100  LET F=2*ATN(T2)/C
4110  LET L=G+F+180+.01719*(J1-T)/365.25
4120  IF L <= 360 THEN 4160
4130  LET L=L-360
4140  GOTO 4120
4160  LET L=L*C
4170  LET S1=SIN(L)*.397835
4180  LET D3=SQR(1-S1^2)
4210  LET D2=FNA(S1)
4220  LET X=COS(L)/D3
4230  LET Y=SIN(L)*.917457/D3
4240  GOSUB 8000
4250  RETURN 
5000  REM GOSUB FOR UNPACKING
5010  LET W1=SGN(W)*INT(ABS(W))
5020  LET W2=ABS(W-W1)*60
5030  LET W3=INT(W2+.5)
5040  IF W3<60 THEN 5050
5042  LET W3=0
5044  LET W1=W1+1
5050  RETURN 
6000  PRINT "MORNING";
6020  LET K3=1
6025  LET B1=1
6030  PRINT TAB(10);
6035  FOR K1=K3 TO K3+3
6036  IF U[K1]#99 THEN 6040
6037  PRINT "  ********  ";
6038  GOTO 6080
6040  LET W=U[K1]-Z
6042  IF W >= 0 THEN 6046
6044  LET W=W+24
6045  GOTO 6050
6046  IF W<24 THEN 6050
6048  LET W=W-24
6050  GOSUB 5000
6060  PRINT W1;W3;
6080  NEXT K1
6085  IF B[B1]#999 THEN 6090
6086  PRINT "****"
6087  GOTO 6095
6090  PRINT INT((B[B1]+.05)*10)/10
6095  IF K1>8 THEN 6150
6100  PRINT "EVENING";
6110  LET B1=2
6120  LET K3=5
6130  GOTO 6030
6150  PRINT 
6160  RETURN 
8000  REM FOUR-QUAD ARCTAN
8020  LET A=ATN(Y/X)
8030  IF X<0 OR Y<0 THEN 8050
8040  RETURN 
8050  IF X>0 AND Y<0 THEN 8080
8060  LET A=A+P
8070  RETURN 
8080  LET A=A+2*P
8090  RETURN 
9000  DATA 19,3,99,99
9998  DATA 9999,9999,9999,9999
9999  END 
