   10 REM  > SABBATSUN,  EX. ALMANAC FOR A WEATHER PERSON
   20 REM BY ALFRED K. BLACKADAR (WEATHERWISE, OCTOBER 1984)
   30 REM ROOM 503 WALKER BLDG
   40 REM UNIVERSITY PARK, PA 16802
   41
   42 FOR D= 1 TO 2
   45 PRINT"PGM DonMcD.BBC-B.Don94/2.SabbatSun,"''"  Friday / Saturday Sunsets"
   46   PRINT'" revised Don S McDonald,  NEW ZEALAND Daylight Time (March-October) "''"63/5 Hut chi Son Road, Wgtn2, N.Zld."
   47   PRINT"Ph. 64 (NZ) +4(WN)+ 389-6820.    10/3/94, 17/4/1994, 10/6/94, 28/11/94."
   46   IF D=1 THEN
   47        PRINT ' "Print Spool to Don94/2.Weatherwis.SplSunTbl,  Press Y/ N"
   48        IF INSTR("Yy",GET$) THEN
   58           *SP. $.DonMcD.BBC-modelB.Don94/2.Weatherwis.SplSunTbl
   49           PRINT "* Spooling Print to Don94/2.Weatherwis.SplSunTbl ";TIME$
   50           ELSE PRINT "NO."
   60           ENDIF
   70        ENDIF
   50 NEXT D
   51 ON ERROR REPORT :  PRINT "  close all #0 AT ERL.  ";ERL : CLOSE#0 : STOP   : REM DEBUG, DON.
   60 READ LO, LA$
   61   PRINT LA$  :  LA = EVAL( LA$) :  REM  DON, 10/6/94.
   70 PRINT"REM SUBSTITUTE YOUR OWN LONGITUDE AND LATITUDE."
   80 REM IN STEP 100. USE DECIMAL DEGREES.
   90 REM EAST LONGITUDES ARE NEGATIVE,WEST POSITIVE
  100 DATA -174.8, -41.3 WELLINGTON N.Z.
  101  REM   CO-ORDS REPL 77.9167;40.833    DON, 10/6/94.
  101CHLONG=LO :  PRINT"Longitude, deg. E. negative = "; CHLONG
  102CHLAT=LA :   PRINT "Latitude, deg. S. negative = "; CHLAT
  110 READ PAAAI,OB,L0,L1,A0,A1,E,EO  :  REM PI IS BBC PSEUDO FUNCTION, DON.
  120 DATA 3.141592654,.409095,4.88376619,.017202791
  130 DATA 6.23471229,.017201970,.016728,.00218
  140 TR=PI/180  : FC=2*PI
  150 SL=15*INT(LO/15+.5) : REM STANDARD LONGITUDE
  160 REM TO SHIFT ONE TIME ZONE WEST, INSERT STEP
  170 REM "175 SL=SL+15";"-" IN LIEU OF "+" IF EAST
  180 TZ=SL/15-4 : REM SELECTS TIME ZONE LABEL
  190 LO=LO*TR : LA=LA*TR : SL = SL*TR
  200 REM REM D STRINGS ARE GROUPS OF 9 CHARS & SPACES
  210 D1$="SUNDAY   MONDAY   TUESDAY  WEDNESDAY"
  220 D2$= "THURSDAY FRIDAY   SATURDAY "
  230 D$= D1$ + D2$  : X$ = " ** "
  240 M$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
  250 Z$="ASTESTCSTMSTPSTYSTASTADTEDTCDTMDTPDTYDTADT"
  260 TN=LO/FC+.5 : REM LONGITUDE TIME OFFSET +12 HR
  270 REM PRINT "DAY"; :INPUT D
  280 REM PRINT "MONTH (#)"; : INPUT M
  290 REM IF M >12 THEN PRINT "INVALID DATE": GOTO 280
  300 PRINT "YEAR";  : INPUT YR
  301  DIM daysinmth(12)
  301  FOR M = 1 TO 12
  302  DATA 31,28,31, 30,31,30, 31, 31, 30, 31,30,31
  303  READ daysinmth(M)
  302  FOR D = 1 TO daysinmth( M)
  303
  310 X=1 : Y=1 : GOSUB 2410
  320 T9=T : REM TIME MARK FOR FIRST DAY OF YEAR
  330 X=D :  Y=M :GOSUB 2410
  340 YD=T-T9+1  : REM DAY OF YEAR
  350 X=INT(T+1)/7  : Y=INT(X)
  360 WD=INT(7*(X-Y)+.5) : REM DAY OF THE WEEK
  361
  362IF WD >= 5 THEN
  363
  370 REM NEXT T IS DAYS AFTER 0HR GMT 1/1/1980
  380 T=T+3449.5 +TN
  385 DT=.00059+2.2E-8*T : T=T+DT : REM TUNE-UP STEPS AUG 85.
  390 REM PRINT : PRINT : PRINT
  400 REM PRINT TAB(2);"ALMANAC - STATE COLLEGE, PA"
  410 REM PRINT TAB(5);MID$(D$,9*WD+1,3);
  411  PRINT "   ";MID$(D$,9*WD+1,3);  :  REM SUPPRESS TAB(5)
  420 PRINT "  "; D;MID$(M$,3*(M-1)+1,3);YR    -1900"  " ;  :  REM ; SUPPRESS CENTURY/ LINEFD
  430 REM PRINT "DAY OF YEAR";YD;" JUL DAY";INT(JD+1)
  440 REM PRINT TAB(14); "SUN"
  450 REM MAKE SUMMER TIME SHIFT AS NEEDED
  460 REM IF NO SUMMER TIME, OMIT STEP 500.
  470 REM TO ALTER DATES OF SHIFT, ADD (ALBEBR'LY)
  480 REM REQ'D # OF DAYS TO "113" AND "298"
  490 X=YD-WD :  S2=SL-15*TR
  500 REM  IF X>113 THEN IF X<298 THEN TZ=TZ+7 : SL = S2
  510 T$= MID$(Z$,3*TZ+1,3)
  610 GOSUB 2860 : REM FIND SUN AT LOCAL NOON
  620 IF DE>PI THEN DE = DE-FC
  630 Q=ML-RA : REM EQ OF TIME (NOT DISPLAYED)
  660 REM PRINT TAB(4); "DECL";INT(DE*100/TR+.5)/100;
  670 REM PRINT "DIST";RV : PRINT "RISE";
  680 X=-.014539  : GOSUB 2360   : REM TUNE -UP AUG 85.
  681REM   PRINT "  SET XXX"
  690 IF ABS(Y) < 1 THEN GOTO 720
  700 REM PRINT X$;X$;T$ "  SET";X$;X$;T$
  710 GOTO 780
  720 S0 = Z : H=-S0 : GOSUB 2260
  724 TC=.00274*S0*SIN(OB)*COS(TL)*SIN(LA)
  725 Z=SIN(S0)*COS(LA)*(COS(DE)^3)
  726 TC=TC/Z
  730 X = ZT+TC+EO : GOSUB 2310  : REM TUNE-UP UAG 85.
  740 REM PRINT X;Y;T$; "  SET";
  750 H=S0 : GOSUB 2260
  760 X=ZT+TC +EO : GOSUB 2310  :REM TUNE-UP AUG 85.
  770 REM  P. X;Y;T$
  771 IF YD<=79 OR YD>=275 THEN X=X+1  :  REM Don daylight saving NZ< 20/3/94, > 2/10/94
  775 PRINT ; (X-12)":"RIGHT$(STR$(100+Y),2)"pm.";T$      ;  :  REM ; SUPPRESS LINEFEED
  776GOTO 821
  780 REM PRINT TAB(4);"TRANSIT";
  790 IF ABS(LA-DE)>PI/2 THEN PRINT X$;X$;T$:GOTO 821  :  REM G. 830
  800 H=0 :GOSUB 2260
  810 X=ZT : GOSUB 2310
  820 PRINT X;Y;Z;T$
  821
  821 IF WD = 6 THEN PRINT
  822ENDIF
  823NEXT
  824PRINT "  SABBATSUN SETS (NZDT) FOR CO-ORDS ";CHLONG", "CHLAT" YEAR="YR" CONT."; GET$
  825  NEXT
  826 PRINT"close spool all  CLOSE#0  (Don McDonald)"  :  CLOSE#0
  830 STOP : REM END OF FIRST INSTALLMENT
  831
  832
 2000 REM SUBR Z = ARCTAN(X/Y)
 2001 REM 0 <= Z < 2*PI
 2010 C=0 : N=0
 2015 REM PI = 3.141592654
 2020 IF Y <> 0 THEN GOTO 2050
 2030 IF X < 0 THEN N = 1
 2040 GOTO 2060
 2050 Z = X/Y
 2060 Z = ATN(Z)
 2070 IF C=1 THEN Z=PI/2 -Z
 2080 IF N=1 THEN Z= -Z
 2090 IF Y < 0 THEN Z = Z +PI
 2100 IF Z < 0 THEN Z = Z + 2*PI
 2110 RETURN
 2111
 2250 REM RADIAN ZONE TIME ZT FROM H=LHA, RA
 2260ZT=H+RA+LO-SL-ML-PI
 2270 X= SIN(ZT)  : Y=COS(ZT)  : GOSUB 2010
 2280 ZT = Z : RETURN
 2281
 2300 REM CONVERT ANGULAR TIME X
 2301 REM   TO X=HR, Y=MIN, Z=SEC
 2310 W=X*24/FC  :  X = INT(W)
 2320 Z = (W-X)*60 : Y=INT(Z)
 2330 Z = INT((Z-Y)*60)  : RETURN
 2350 REM Z = LHA FROM X=COS(ZENITH ANGLE)
 2360 Y=(X-SIN(LA)*SIN(DE))/(COS(LA)*COS(DE))
 2370 IF ABS(Y) >1 THEN GOTO 2390
 2380 X = SQR(1-Y^2) : GOSUB 2010
 2390 RETURN
 2391
 2392
 2400 REM JULIAN DAY (JD) FROM DATE
 2401 REM X = DAY, Y=MONTH, YR = YEAR
 2410 T= 367*(YR-1980)
 2420 T=T-INT(7*(YR+INT((Y+9)/12))/4)
 2430 S = SGN(Y-9)  : A = ABS(Y-9)
 2440 Z =INT((YR+S*INT(A/7))/100)
 2450 T=T-INT(3*(Z+1)/4)
 2460 T=T+INT(275*Y/9)+X-.5
 2470 JD= T+2447689
 2480 RETURN
 2481
 2484
 2850 REM SUN'S RA, DECL, AND RADIUS VECTOR
 2860 MA=A0+A1*T  :  REM  MEAN ANOMALY
 2870 ML = L0 + L1*T : REM MEAN CELESTIAL LONGITUDE?? INACC.
 2880 X = SIN(ML) : Y=COS(ML) : GOSUB 2010
 2890 ML=Z  : REM 0<=ML<2*PI
 2900 DL=2*E*SIN(MA)+1.25*E^2*SIN(2*MA)
 2910 TA=MA+DL : TL=ML+DL  : REM TRUE ANOM & LONG
 2920 RV = (1-E^2)/(1+E*COS(TA)) : REM RADIUS VECTOR
 2930 X=SIN(TL)*SIN(OB)  : Y= SQR(1-X^2) : GOSUB 2010
 2940 DE=Z : IF Z > PI THEN Z=Z-FC
 2950 X=SIN(TL)*COS(OB)  : Y= COS(TL) : GOSUB 2010
 2960 RA=Z : REM SUN'S RIGHT ASCENSION
 2970 RETURN
 3000 END
 3001
 3002