home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG139.ARC / MOONTIMZ.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  17KB  |  514 lines
  1. 1    REM
  2. 2    REM    PROGRAM    MOONRISE
  3. 3    REM
  4.  
  5. 5    DEF FNRAD(W) = 1.745329252E-2 * W
  6.      DEF FNDEG(W) = 5.729577951E1 * W
  7.      DEF FNASN(W) = ATN(W/(SQR(1-W*W)+1E-20))
  8.      DEF FNACS(W) = 1.570796327-FNASN(W)
  9.  
  10.      DIM FLAG(9)
  11.      FLAG(0) = 0 : FLGA = 0
  12.  
  13.  
  14. 10    PRINT CHR$(26)
  15. 13     PRINT "* * * * * * * * * * * * * * * *     MOON";\
  16.         "TIMZ    * * * * * * * * * * * * * * * *"
  17. 14     PRINT "*                                       ";\
  18.         "                                      *"
  19. 15     PRINT "*                SHOWS TIME AND DIRECTIO";\
  20.         "N OF MOONRISE AND MOONSET             *"
  21. 16     PRINT "*                                       ";\
  22.         "                                      *"
  23. 17    PRINT "* SET FOR  PEMBROOKE, NSW  -|- LONGITUDE";\
  24.         " 152.45.00 E, LATITUDE 31.24.00 S     *" 
  25. 18    PRINT "*                                       ";\
  26.         "                                      *"
  27. 19    PRINT "*                               copyrigh";\
  28.         "t,  1990                              *"
  29. 20    PRINT "*                                  Terry";\
  30.         " Hill                                 *"
  31. 21    PRINT "*                                (065) 8";\
  32.         "5 9264                                *"
  33. 22    PRINT "*                                       ";\
  34.         "                                      *"
  35. 31     PRINT "* * * * * * * * * * * * * * * * * * * * *";\
  36.         " * * * * * * * * * * * * * * * * * * *"
  37. 32    PRINT
  38. 33    PRINT "MOONTIMZ shows the time of the Moon's rising and";\
  39.     " setting for a given day. The "
  40. 34    PRINT "time of rising is calculated first, and then the";\
  41.     " time of setting. If Moonset is"
  42. 35    PRINT "EARLIER than Moonrise, the Moonset is at that ti";\
  43.     "me on the FOLLOWING day.    "
  44. 36    PRINT "Comparison with an ephemeris can be confusing at";\
  45.     " first. Times are accurate"
  46. 37    PRINT "to within a minute or two. Azimuth bearings are e";\
  47.     "ast of North.                "
  48. 38    PRINT "Local mean time is used - for daylight saving ";\
  49.     "either adjust the time zone or"
  50. 39    PRINT "calculate mentally. Input is terminated with a <CR>.";\
  51.     "If you make an error, use"
  52. 40    PRINT "<BACKSPACE> and reinput before typing <CR>."
  53. 41    PRINT "You can review and alter the input before the ";\
  54.     " calculation is made."
  55. 42    PRINT
  56. 43    LONG$ = "+152.75"
  57. 44    LAT$  = "-31.40"
  58. 45    ZONE$ = "+10"
  59. 46    PLACE$ = "PEMBROOKE, NSW"
  60.      LONG = VAL(LONG$)
  61.      LAT = VAL(LAT$)
  62.      ZONE = VAL(ZONE$)
  63.  
  64. 50    INPUT "CHANGE LOCATION (Y/N) ";YES$
  65. 51    IF YES$ = "N" OR YES$ = "n" THEN GOTO 90
  66.      FLAG(9) = 0
  67. 52    INPUT "NEW LOCATION   (14 chars max) : "; PLACE$
  68. 53    INPUT "NEW LONGITUDE  (+/-ddd,mm,ss) : "; XD,XM,XS
  69. 54    GOSUB 1035
  70. 55    LONG = X
  71. 56    INPUT "NEW LATITUDE  (+/-dd,mm,ss)   : "; XD,XM,XS
  72. 57    GOSUB 1035
  73. 58    LAT = X
  74. 59    INPUT "NEW TIME ZONE (+/-hh,mm,ss)   : "; XD,XM,XS
  75. 60    GOSUB 1035
  76. 61    ZONE = X
  77. 90    LOCN$ = PLACE$
  78. 91    PRINT CHR$(26)
  79. 92    PRINT "LOCATION  : ";LOCN$;TAB(40);"TIME ZONE : ";ZONE
  80. 93    PRINT "LONGITUDE : ";LONG;TAB(40);"LATITUDE  : ";LAT
  81. 94    PRINT
  82.  
  83.      IF FLGA = 0 THEN GOTO 111  REM BYPASSES TEST ON FIRST PASS
  84.      INPUT "New Date  (Y/N) "; AN$
  85.      IF AN$ = "N" OR AN$ = "n" THEN GOTO 127
  86.      FLAG(1) = 0 : FLAG(5) = 0 : FLAG(6) = 0 : FLAG(3) = 0
  87. 101 REM
  88. 102 REM     INPUT DATA
  89. 103 REM
  90. 111     INPUT "1 YEAR    (yyyy)     : "; YR
  91. 113     INPUT "2 MONTH   (mm)       : "; MN
  92. 115     INPUT "3 DAY     (dd)       : "; DYA
  93. 120    PRINT
  94. 121    INPUT "ENTER 4 TO RUN OR 1..3 TO ALTER INPUT "; ANS
  95. 123     IF ANS <1 OR ANS >9 THEN GOTO 121
  96. 125     ON ANS GOTO 111,113,115,127
  97.  
  98.  
  99. 127    FLGA = 1
  100.      DY = DYA - (ZONE / 24)
  101.  
  102. 155    PHI = FNRAD(LAT)
  103. 175    PRINT CHR$(26)
  104.      PRINT "LOCATION  : ";LOCN$;TAB(40);"TIME ZONE : ";ZONE
  105.      PRINT "LONGITUDE : ";LONG;TAB(40);"LATITUDE  : ";LAT
  106.      PRINT "DATE : "; YR; MN; DYA; " LMT"
  107.      PRINT "Sorry, but this can be a big job even for a BEE!"
  108.  
  109. 180    GOSUB 6400
  110. 185    IF ERR1 NE 0 THEN GOTO 230
  111. 190    PRINT "Local Time of moonrise: "; HSR; MSR
  112. 195    IF ERR4 = 1 THEN PRINT "** POSSIBLE ERROR **"
  113. 200    PRINT "          and moonset: "; HSS; MSS
  114. 205    IF ERR5 = 1 THEN PRINT "** POSSIBLE ERROR **"
  115. 210    AZR0 = FNDEG(AZR0) : AZS0 = FNDEG(AZS0)
  116. 215    PRINT "Azimuths (deg) are"
  117. 220    PRINT "Azimuth of rising: "; AZR0; " deg."
  118. 225    PRINT "      and setting: "; AZS0; " deg."
  119. 230    PRINT
  120.  
  121. 235    INPUT "Again    (Y/N) "; AN$
  122. 240    IF AN$ = "N" OR AN$ = "n" THEN STOP
  123. 65    GOTO 50
  124.  
  125. 997    REM
  126. 998    REM     Subroutine MINSEC
  127. 999    REM
  128.  
  129. 1000    IF SW1 = -1 THEN GOTO 1035
  130. 1005    SN = SGN(X): XP = ABS(X): XD = INT(XP)
  131. 1010    A = (XP - XD)*60: XM = INT(A)
  132. 1015    XS = INT((A - XM)*600 + 0.5) /10
  133. 1020    S$ = "+"
  134. 1025    IF SN = -1 THEN S$ = "-"
  135. 1030    RETURN
  136.  
  137. 1035    SN = +1
  138. 1040    IF XD<0 OR XM<0 OR XS<0 THEN SN = -1
  139. 1045    XD1 = ABS(XD): XM1 = ABS(XM): XS1 = ABS(XS)
  140. 1050    X = ((((XS1/60) + XM1) /60) +XD1) *SN
  141. 1055    RETURN
  142.  
  143. 1097    REM
  144. 1098    REM     SUBROUTINE JULDAY
  145. 1099    REM
  146.  
  147. 1100    IF FLAG(1) = 1 THEN GOTO 1170
  148. 1110    MN1 = MN: YR1 = YR: FLAG(1) = 1: B = 0
  149. 1115    IF YR1 < 0 THEN YR1 = YR1 + 1
  150. 1120    IF MN < 3 THEN MN1 = MN + 12: YR1 = YR1 - 1
  151. 1125    IF YR < 1582 THEN GOTO 1145
  152. 1130    IF YR = 1582 AND MN < 10 THEN GOTO 1145
  153. 1135    IF YR = 1582 AND MN = 10 AND DY < 15 THEN GOTO 1145
  154. 1140    A = INT(YR1/100): B = 2 - A + INT(A/4)
  155. 1145    IF YR1 < 0 THEN GOTO 1155
  156. 1150    C = INT(365.25*YR1) - 694025.0 :GOTO 1160
  157. 1155    C = INT((365.25*YR1) - 0.75) - 694025.0
  158. 1160    D = INT(30.6001*(MN1+1))
  159. 1165    DJD = B + C + D + DY - 0.5
  160. 1170    RETURN
  161.  
  162.  
  163. 1297    REM
  164. 1298    REM    Subroutine GTIME
  165. 1299    REM
  166.  
  167. 1300    IF FLAG(3)=1 THEN GOTO 1340
  168. 1305    XMN=MN: XDY=DY: FLAG(3)=1
  169. 1310    FLAG(1)=0: GOSUB 1100: XDJD=DJD
  170. 1315    MN=1: DY=0: FLAG(1)=0
  171. 1320    GOSUB 1100: T=DJD/36525
  172. 1325    R=6.6460656+(5.1262E-2+(T*2.581E-5))*T
  173. 1330    R1=2400*(T-((YR-1900)/100)): B=24-R-R1
  174. 1335    T0=((XDJD-DJD)*6.57098E-2)-B
  175. 1340    IF SW2=1 THEN GOTO 1365
  176.  
  177. 1345    IF T0<0 THEN T0=T0+24
  178. 1350    GTM=TIM-T0
  179. 1355    IF GTM<0 THEN GTM=GTM+24
  180. 1360    GTM=GTM*9.972695677E-1: GOTO 1380
  181.  
  182. 1365    GTM=(TIM*1.002737908)+T0
  183. 1370    IF GTM>24 THEN GTM=GTM-24
  184. 1375    IF GTM<0 THEN GTM=GTM+24
  185.  
  186. 1380    X=GTM: SW1=1: GOSUB 1000
  187. 1385    HS=XD: MS=XM: SS=XS
  188. 1390    MN=XMN: DY=XDY: DJD=XDJD
  189. 1395    RETURN
  190.  
  191.  
  192. 1697    REM
  193. 1698    REM    subroutine OBLIQ
  194. 1699    REM
  195.  
  196. 1700    IF FLAG(5)=1 THEN RETURN
  197. 1705    FLAG(5)=1
  198. 1710    GOSUB 1100: T=DJD/36525
  199. 1715    C=(((-1.81E-3*T)+5.9E-3)*T+4.6845E1)*T
  200. 1720    EPS=2.345229444E1-(C/3600)
  201. 1725    EPSR=EPS*1.745329252E-2
  202. 1730    RETURN
  203.  
  204. 1797    REM
  205. 1798    REM    Subroutine EQECL
  206. 1799    REM
  207.  
  208. 1800    IF FLAG(7)=1 THEN GOTO 1830
  209. 1810    PI=3.1415926535: TPI=2*PI: FLAG(7)=1
  210. 1815    IF FLAG(6)=0 THEN DEPS=0
  211. 1820    GOSUB 1700: EPS1=FNRAD(EPS+DEPS)
  212. 1825    SEPS=SIN(EPS1): CEPS=COS(EPS1)
  213.  
  214. 1830    CY=COS(Y): SY=SIN(Y)
  215. 1835    IF ABS(CY)<1E-20 THEN CY=1E-20
  216. 1840    TY=SY/CY: CX=COS(X): SX=SIN(X)
  217. 1845    SQ=(SY*CEPS)-(CY*SEPS*SX*SW3)
  218. 1850    Q=FNASN(SQ): A=(SX*CEPS)+(TY*SEPS*SW3)
  219. 1855    P=ATN(A/CX)
  220. 1860    IF CX<0 THEN P=P+PI
  221. 1865    IF P>TPI THEN P=P-TPI
  222. 1870    IF P<0 THEN P=P+TPI
  223. 1875     RETURN
  224.  
  225. 2097    REM
  226. 2098    REM    SUBROUTINE RISET
  227. 2099    REM
  228.  
  229. 2100    IF FLAG(9) = 1 THEN GOTO 2125
  230. 2115    CPHI = COS(PHI) : SPHI = SIN(PHI)
  231. 2120    TPI = 6.283185308 : FLAG(9) = 1
  232.  
  233. 2125    CY = COS(Y) : A = CY * CPHI
  234. 2130    IF ABS(A) < 1E-10 THEN GOTO 2260
  235.  
  236. 2135    CPSI = SPHI / CY
  237. 2140    IF CPSI > 1 THEN CPSI = 1
  238. 2145    IF CPSI < -1 THEN CPSI = -1
  239. 2150    PSI = FNACS(CPSI) : SPSI = SIN(PSI)
  240. 2155    DH = DIS * SPSI : Y1 = Y + (DIS * CPSI)
  241. 2160    SY = SIN(Y1) : TY = TAN(Y1)
  242. 2165    CH = (-1 * SPHI * TY) / CPHI
  243.  
  244. 2170    IF CH < -1 THEN GOTO 2240
  245. 2175     IF CH > 1 THEN GOTO 2250
  246.  
  247. 2180    ERR1 = 0 : H = FNACS(CH)
  248. 2185    H = (H + DH) * 3.819718634
  249. 2190    LSTR = 24 + X - H : LSTS = X + H
  250. 2195    CAZR = SY / CPHI : AZR = FNACS(CAZR)
  251. 2200    AZS = TPI - AZR : B = LSTR : C = 24 : GOSUB 2225
  252. 2205    LSTR = B : B = LSTS : GOSUB 2225 : LSTS = B
  253. 2210    B = AZR : C = TPI : GOSUB 2225 : AZR = B
  254. 2215    B = AZS : GOSUB 2225 : AZS = B
  255. 2220    RETURN
  256.  
  257. 2225    IF B < 0 THEN B = B + C
  258. 2230    IF B > C THEN B = B - C
  259. 2235    RETURN
  260.  
  261. 2240    ERR1 = -1 : PRINT "** circumpolar **"
  262. 2245    RETURN
  263. 2250    ERR1 = 1  : PRINT "** never rises **"
  264. 2255    RETURN
  265. 2260    ERR1 = 2  : PRINT "** IMPOSSIBLE CALCULATION **"
  266. 2265    RETURN
  267.  
  268.  
  269.  
  270.  
  271. 2697    REM
  272. 2698    REM     Subroutine    NUTAT
  273. 2699    REM
  274.  
  275. 2700    IF FLAG(6) = 1 THEN RETURN
  276. 2710    FLAG(6) = 1 : FLAG(7) = 0
  277. 2715    GOSUB 1100 : T = DJD / 36525 : T2 = T * T
  278. 2720    A = 1.000021358E2 * T : B = 360 * (A - INT(A))
  279. 2725    LS = 2.796967E2 + 3.03E-4 * T2 + B
  280. 2730    A = 1.336855231E3 * T : B = 360 * (A - INT(A))
  281. 2735    LD = 2.704342E2 - 1.133E-3 * T2 + B
  282. 2740    A = 9.999736056E1 * T : B= 360 * (A - INT(A))
  283. 2745    MS = 3.584758E2 - 1.5E-4 * T2 + B
  284. 2750    A = 1.325552359E7 * T : B = 360 * (A - INT(A))
  285. 2755    MD = 2.961046E2 + 9.192E-3 * T2 + B
  286. 2760    A = 5.372616667 * T : B = 360 * (A - INT(A))
  287. 2765    NM = 2.591833E2 + 2.078E-3 * T2 -B
  288. 2770    TLS = 2 * FNRAD(LS) : NM = FNRAD(NM)
  289. 2775    TNM = 2 * FNRAD(NM) : MS = FNRAD(MS)
  290. 2780    TLD = 2 * FNRAD(LD) : MD = FNRAD(MD)
  291.  
  292. 2785    DPSI=(-17.2327-1.737E-2*T)*SIN(NM)\
  293.     +(-1.2729-1.3E-4*T)*SIN(TLS)\
  294.     +2.088E-1*SIN(TNM)-2.037E-1*SIN(TLD)\
  295.     +(1.261E-1-3.1E-4*T)*SIN(MS)\
  296.     +6.75E-2*SIN(MD)\
  297.     -(4.97E-2-1.2E-4*T)*SIN(TLS+MS)\
  298.     -3.42E-2*SIN(TLD-NM)-2.61E-2*SIN(TLD+MD)\
  299.     +2.14E-2*SIN(TLS-MS)\
  300.     -1.49E-2*SIN(TLS-TLD+MD)\
  301.     +1.24E-2*SIN(TLS-NM)+1.14E-2*SIN(TLD-MD)
  302.  
  303. 2790    DEPS=(9.21+9.1E-4*T)*COS(NM)\
  304.     +(5.522E-1-2.9E-4*T)*COS(TLS)\
  305.     -9.04E-2*COS(TNM)+8.84E-2*COS(TLD)\
  306.     +2.16E-2*COS(TLS+MS)+1.83E-2*COS(TLD-NM)\
  307.     +1.3E-2*COS(TLD+MD)-9.3E-3*COS(TLS-MS)\
  308.     -6.6E-3*COS(TLS-NM)
  309.  
  310. 2795    DPSI = DPSI / 3600 : DEPS = DEPS / 3600
  311. 2800    RETURN
  312.  
  313.  
  314. 5997    REM
  315. 5998    REM    Subroutine    MOON
  316. 5999    REM
  317.  
  318. 6000    GOSUB 1100 : T = DJD / 36525 : T2 = T * T
  319. 6010    M1 = 2.732158213E1 : M2 = 3.652596407E2
  320. 6015    M3 = 2.755455094E1 : M4 = 2.953058868E1
  321. 6020    M5 = 2.721222039E1 : M6 = 6.798363307E3
  322. 6025    M1 = DJD / M1 : M2 = DJD / M2 : M3 = DJD / M3
  323. 6030    M4 = DJD / M4 : M5 = DJD / M5 : M6 = DJD / M6
  324. 6035    M1 = 360 * (M1 - INT(M1)) : M2 = 360 * (M2 - INT(M2))
  325. 6040    M3 = 360 * (M3 - INT(M3)) : M4 = 360 * (M4 - INT(M4))
  326. 6045    M5 = 360 * (M5 - INT(M5)) : M6 = 360 * (M6 - INT(M6))
  327. 6050    LD = 2.70434164E2 + M1 - (1.133E-3 - 1.9E-6 * T) *T2
  328. 6055    MS = 3.58475833E2 + M2 - (1.5E-4 + 3.3E-6 * T) * T2
  329. 6060    MD = 2.96104608E2 + M3 + (9.192E-3 + 1.44E-5 * T) * T2
  330. 6065    DE = 3.50737486E2 + M4 - (1.436E-3 - 1.9E-6 * T) * T2
  331. 6070    F = 11.250889 + M5 - (3.211E-3 + 3E-7 * T) * T2
  332. 6075    N = 2.59183275E2 - M6 + (2.078E-3 + 2.2E-5 * T) * T2
  333. 6080    A = FNRAD(51.2 + 20.2 * T) : SA = SIN(A)
  334. 6085    SN = SIN(FNRAD(N))
  335. 6090    B = 346.56 + (132.87 - 9.1731E-3 * T) * T
  336. 6100    SB = 3.964E-3 * SIN(FNRAD(B))
  337. 6105    C = FNRAD(N + 275.05 - 2.3 * T) : SC = SIN(C)
  338. 6110    LD = LD + 2.33E-4 * SA + SB + 1.964E-3 * SN
  339. 6115    MS = MS - 1.778E-3 * SA
  340. 6120    MD = MD + 8.17E-4 * SA + SB + 2.541E-3 * SN
  341. 6125    F = F + SB - 2.4691E-2 * SN - 4.328E-3 * SC
  342. 6130    DE = DE + 2.011E-3 * SA + SB + 1.964E-3 * SN
  343. 6135    E = 1 -  (2.495E-3 + 7.52E-6 *T) * T  : E2 = E * E
  344. 6140    LD = FNRAD(LD) : MS = FNRAD(MS) : N = FNRAD(N)
  345. 6145    DE = FNRAD(DE) : F = FNRAD(F) : MD = FNRAD(MD)
  346.  
  347. 6150    L = 6.28875 * SIN(MD) + 1.274018 * SIN(2 * DE - MD)\
  348.     + 6.58309E-1 * SIN(2 * DE)\
  349.     + 2.13616E-1 * SIN(2 * MD)\
  350.     - E * 1.85596E-1 * SIN(MS)\
  351.     - 1.14336E-1 * SIN(2 * F)\
  352.     + 5.8793E-2 * SIN(2 * (DE - MD))\
  353.     + 5.7212E-2 * E * SIN(2 * DE - MS - MD)\
  354.     + 5.332E-2 * SIN(2 * DE + MD)\
  355.     + 4.5874E-2 * E * SIN(2 * DE - MS)\
  356.     + 4.1024E-2 * E * SIN(MD - MS)\
  357.     - 3.4718E-2 * SIN(DE) - E * 3.0465E-2 * SIN(MS + MD)\
  358.     + 1.5326E-2 * SIN(2 * (DE - F))\
  359.     - 1.2528E-2 * SIN(2 * F + MD)\
  360.     - 1.098E-2 * SIN(2 * F - MD)\
  361.     + 1.0674E-2 * SIN(4 * DE - MD)\
  362.     + 1.0034E-2 * SIN(3 * MD)\
  363.     + 8.548E-3 * SIN(4 * DE - 2 * MD)\
  364.     - E * 7.91E-3 * SIN(MS - MD + 2 * DE)\
  365.     - E * 6.783E-3 * SIN(2 * DE + MS)\
  366.     + 5.162E-3 * SIN(MD - DE) + E * 5E-3 * SIN(MS + DE)\
  367.     + 3.862E-3 * SIN(4 * DE)\
  368.     + E * 4.049E-3 * SIN(MD - MS + 2 * DE)\
  369.     + 3.996E-3 * SIN(2 * (MD + DE))\
  370.     + 3.665E-3 * SIN(2 * DE - 3 * MD)\
  371.     + E * 2.695E-3 * SIN(2 * MD - MS)\
  372.     + 2.602E-3 * SIN(MD - 2 * (F + DE))\
  373.     + E * 2.396E-3 * SIN(2 * (DE - MD) - MS)\
  374.     - 2.349E-3 * SIN(MD + DE)\
  375.     + E2 * 2.249E-3 * SIN(2 * (DE - MS))\
  376.     - E * 2.125E-3 * SIN(2 * MD + MS)\
  377.     - E2 * 2.079E-3 * SIN(2 * MS)\
  378.     + E2 * 2.059E-3 * SIN(2 * (DE - MS) - MD)\
  379.     - 1.773E-3 * SIN(MD + 2 * (DE - F))\
  380.     - 1.595E-3 * SIN(2 * (F + DE))\
  381.     + E * 1.22E-3 * SIN(4 * DE - MS - MD)\
  382.     - 1.11E-3 * SIN(2 * (MD + F))\
  383.     + 8.92E-4 * SIN(MD - 3 * DE)\
  384.     - E * 8.11E-4 * SIN(MS + MD + 2 * DE)\
  385.     + E * 7.61E-4 * SIN(4 * DE - MS - 2 * MD)\
  386.     + E2 * 7.04E-4 * SIN(MD - 2 * (MS + DE))\
  387.     + E * 6.93E-4 * SIN(MS - 2 * (MD - DE))\
  388.     + E * 5.98E-4 * SIN(2 * (DE - F) - MS)\
  389.     + 5.5E-4 * SIN(MD + 4 * DE) + 5.38E-4 * SIN(4 * MD)\
  390.     + E * 5.21E-4 * SIN(4 * DE - MS)\
  391.     + 4.86E-4 * SIN(2 * MD - DE)\
  392.     + E2 * 7.17E-4 * SIN(MD - 2 * MS)
  393. 6160    LAM = LD + FNRAD(L) : TPI = 6.283185308
  394. 6165    IF LAM < 0 THEN LAM = LAM + TPI : GO TO 6165
  395. 6170    IF LAM > TPI THEN LAM = LAM - TPI : GO TO 6170
  396.  
  397. 6175    G = 5.128189 * SIN(F) + 2.80606E-1 * SIN(MD + F)\
  398.     + 2.77693E-1 * SIN(MD - F)\
  399.     + 1.73238E-1 * SIN(2 * DE - F)\
  400.     + 5.5413E-2 * SIN(2 * DE + F - MD)\
  401.     + 4.6272E-2 * SIN(2 * DE - F - MD)\
  402.     + 3.2573E-2 * SIN(2 * DE + F)\
  403.     + 1.7198E-2 * SIN(2 * MD + F)\
  404.     + 9.267E-3 * SIN(2 * DE + MD - F)\
  405.     + 8.823E-3 * SIN(2 * MD - F)\
  406.     + E * 8.247E-3 * SIN(2 * DE - MS - F)\
  407.     + 4.323E-3 * SIN(2 * (DE - MD) - F)\
  408.     + 4.2E-3 * SIN(2 * DE + F + MD)\
  409.     + E * 3.372E-3 * SIN(F - MS - 2 * DE)\
  410.     + E * 2.472E-3 * SIN(2 * DE + F - MS - MD)\
  411.     + E * 2.222E-3 * SIN(2 * DE + F - MS)\
  412.     + E * 2.072E-3 * SIN(2 * DE - F - MS - MD)\
  413.     + E * 1.877E-3 * SIN(F - MS + MD)\
  414.     + 1.828E-3 * SIN(4 * DE - F - MD)\
  415.     - E * 1.803E-3 * SIN(F + MS) - 1.75E-3 * SIN(3 * F)\
  416.     + E * 1.57E-3 * SIN(MD - MS - F)\
  417.     - 1.487E-3 * SIN(F + DE)\
  418.     - E * 1.481E-3 * SIN(F + MS + MD)\
  419.     + E * 1.417E-3 * SIN(F - MS - MD)\
  420.     + E * 1.35E-3 * SIN(F - MS) + 1.33E-3 * SIN(F - DE)\
  421.     + 1.106E-3 * SIN(F + 3 * MD) + 1.02E-3 * SIN(4 * DE - F)\
  422.     + 8.33E-4 * SIN(F + 4 * DE - MD)\
  423.     + 7.81E-4 * SIN(MD - 3 * F)\
  424.     + 6.7E-4 * SIN(F + 4 * DE - 2 * MD)\
  425.     + 6.06E-4 * SIN(2 * DE - 3 * F)\
  426.     + 5.97E-4 * SIN(2 * (DE + MD) - F)\
  427.     + E * 4.92E-4 * SIN(2 * DE + MD - MS - F)\
  428.     + 4.5E-4 * SIN(2 * (MD - DE) - F)\
  429.     + 4.39E-4 * SIN(3 * MD - F)\
  430.     + 4.23E-4 * SIN(F + 2 * (DE + MD))\
  431.     + 4.22E-4 * SIN(2 * DE - F - 3 * MD)\
  432.        - E * 3.67E-4 * SIN(MS + F + 2 * DE - MD)\
  433.     - E * 3.53E-4 * SIN(MS + F + 2 * DE)\
  434.     + 3.31E-4 * SIN(F + 4 * DE)\
  435.     + E * 3.17E-4 * SIN(2 * DE + F - MS + MD)\
  436.     + E2 * 3.06E-4 * SIN(2 * (DE - MS) - F)\
  437.     - 2.83E-4 * SIN(MD + 3 * F)
  438. 6185    W1 = 4.664E-4 * COS(N) : W2 = 7.54E-5 * COS(C)
  439. 6190    BET = FNRAD(G) * (1 - W1 - W2)
  440.  
  441. 6195    HP = 9.50724E-1 + 5.1818E-2 * COS(MD)\
  442.     + 9.531E-3 * COS(2 * DE - MD)\
  443.     + 7.843E-3 * COS(2 * DE) + 2.824E-3 * COS(2 * MD)\
  444.     + 8.57E-4 * COS(2 * DE + MD)\
  445.     + E * 5.33E-4 * COS(2 * DE - MS)\
  446.     + E * 4.01E-4 * COS(2 * DE - MD - MS)\
  447.     + E * 3.2E-4 * COS(MD - MS) - 2.71E-4 * COS(DE)\
  448.     - E * 2.64E-4 * COS(MS + MD)\
  449.     - 1.98E-4 * COS(2 * F - MD) + 1.73E-4 * COS(3 * MD)\
  450.     + 1.67E-4 * COS(4 * DE - MD) - E * 1.11E-4 * COS(MS)\
  451.     + 1.03E-4 * COS(4 * DE - 2 * MD)\
  452.     - 8.4E-5 * COS(2 * MD - 2 * DE)\
  453.     - E * 8.3E-5 * COS(2 * DE + MS)\
  454.     + 7.9E-5 * COS(2 * DE + 2 * MD) + 7.2E-5 * COS(4 * DE)\
  455.     + E * 6.4E-5 * COS(2 * DE - MS + MD)\
  456.     - E * 6.3E-5 * COS(2 * DE + MS - MD)\
  457.     + E * 4.1E-5 * COS(MS + DE)\
  458.     + E * 3.5E-5 * COS(2 * MD - MS)\
  459.     - 3.3E-5 * COS(3 * MD - 2 * DE) - 3E-5 * COS(MD + DE)\
  460.     - 2.9E-5 * COS(2 * (F - DE))\
  461.     - E * 2.9E-5 * COS(2 * MD + MS)\
  462.     + E2 * 2.6E-5 * COS(2 * (DE - MS))\
  463.     - 2.3E-5 * COS(2 * (F - DE) + MD)\
  464.     + E * 1.9E-5 * COS(4 * DE - MS - MD)
  465. 6205    HP = FNRAD(HP)
  466. 6210    RETURN
  467.  
  468.  
  469.  
  470. 6397    REM
  471. 6398    REM     Subroutine    MOONRS
  472. 6399    REM
  473.  
  474. 6400    DY0 = DY : MN0 = MN : YR0 = YR : DY = DY0 + 0.5
  475. 6415    GOSUB 6530
  476. 6420    IF ERR1 NE 0 THEN RETURN
  477. 6425    PASS = 0 : AL = LNG / 15
  478. 6430    TR = LSTR - AL : TS = LSTS - AL : GOSUB 6565
  479. 6435    ERR4 = 0 : ERR5 = 0
  480. 6440    DY = DY0 : PASS = PASS + 1
  481. 6445    TIM = TR : SW2 = -1 : GOSUB 1300
  482. 6450    IF GTM > 23.5 OR GTM < 0.5 THEN ERR4 = 1
  483. 6455    GTMR = GTM : TIM = TS : GOSUB 1300
  484. 6460    IF GTM > 23.5 OR GTM < 0.5 THEN ERR5 = 1
  485. 6465    GTMS = GTM : DJD0 = DJD
  486. 6470    DJD = DJD0 + GTMR / 24 : GOSUB 6530
  487. 6475    IF ERR1 NE 0 THEN RETURN
  488. 6480    AZR0 = AZR : TR = LSTR - AL
  489. 6485    DJD = DJD0 + GTMS / 24 : GOSUB 6530
  490. 6490    IF ERR1 NE 0 THEN RETURN
  491. 6495    AZS0 = AZS : TS = LSTS - AL : GOSUB 6565
  492. 6500    IF PASS < 2 THEN GOTO 6440
  493.  
  494. 6505    DY = DY0 : TIM = TR + 8.333E-3 : GOSUB 1300
  495. 6510    HSR = HS : MSR = MS
  496. 6515    TIM = TS + 8.333E-3 : GOSUB 1300
  497. 6520    HSS = HS : MSS = MS
  498. 6525    RETURN
  499.  
  500. 6530    GOSUB 6000 : GOSUB 2700
  501. 6535    TH = 2.7249E-1 * SIN(HP) : HT = 0
  502. 6540    DIS = TH + 9.8902E-3 - HP
  503. 6545    X = FNRAD(DPSI) + LAM : Y = BET
  504. 6550    SW3 = -1 : GOSUB 1800
  505. 6555    X = FNDEG(P / 15) : Y = Q : GOSUB 2100
  506. 6560    RETURN
  507.  
  508. 6565    IF TR < 0 THEN TR = TR + 24
  509. 6570    IF TR > 24 THEN TR = TR - 24
  510. 6575    IF TS < 0 THEN TS = TS + 24
  511. 6580    IF TS > 24 THEN TS = TS - 24
  512. 6585    RETURN
  513.  
  514.