home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / misc / astrol5.arc / ASTROL5.BAS next >
Encoding:
BASIC Source File  |  1979-12-31  |  14.1 KB  |  267 lines
  1. 999 REM  UTILITIES
  2. 1000 DEFINT I
  3. 1001 DIM H(12),H$(12),C$(12),F$(10),T(3),CH(12),CL(12),C(12),M(12),K(9)
  4. 1003 PI! = 3.14159: REM  DEFINE `PI'
  5. 1005 DEF FNR(X!) = PI! / 180 * X!: REM  CONVERTS DEGREES TO RADIANS
  6. 1007 ZA$ = "ARTAGECALEVILISCSACPAQPI"
  7. 1010 DEF FND(X!) = 180 / PI! * X!: REM  CONVERTS RADIANS TO DEGREES
  8. 1015 DEF FNQ(X!) = SGN (X!) * (  INT (  ABS (X!)) + ( ABS (X!) - INT ( ABS (X!))) * 100 / 60): REM  CONVERTS DEGREES/MINUTES TO DEGREES DECIMAL
  9. 1020 DEF FNU(X!) = X! - ( INT (X! / MO) * MO):MO = 360: REM  MODULUS FUNCTION, RETURNS RESULT WITHIN CIRCLE
  10. 1025 DEF FNW(X!) =  INT (X! * 100 + .5) / 100: REM  ROUNDS OFF TO TWO DECIMAL PLACES
  11. 1030 DEF FNX(X!) = ATN (X! /  SQR (1 - X! * X!)): REM  ARCSINE FUNCTION
  12. 1035 DEF FNY(X!) = ATN ( SQR (1 - X! * X!) / X!): REM  ARCCOSINE FUNCTION
  13. 1040 DEF FNS(X!) = SIN (PI! / 180 * X!): REM  SINE FUNCTION WHEN WORKING WITH DEGREES
  14. 1045 DEF FNC(X!) = COS (PI! / 180 * X!): REM  COSINE FUNCTION WHEN WORKING WITH DEGREES
  15. 1050 DEF FNT(X!) =  TAN (PI! / 180 * X!): REM  TANGENT FUNCTION WHEN WORKING WITH DEGREES
  16. 1051 DEF FNP(X!)=SGN (X!)*((ABS(X!)/M!)/360-INT((ABS(X!)/M!)/360))*360
  17. 1052 DATA SUN,MER,VEN,MAR,JUP,SAT,URA,NEP,PLU,MOO
  18. 1055 FOR I = 1 TO 10: READ C$(I): NEXT I: REM  FILL PLANET NAME ARRAY
  19. 1090 INPUT"DATE: MM.DDYYYY ";DA$
  20. 1092 A$=DA$
  21. 1095 M= VAL(MID$(A$,1,2))
  22. 1100 D= VAL(MID$(A$,4,2))
  23. 1105 Y= VAL(MID$(A$,6,5))
  24. 1110 INPUT"AM*PM ";TI$
  25. 1112 F$=TI$
  26. 1115 INPUT"TIME: HH.MM ";TI
  27. 1117 F!=TI
  28. 1120 INPUT"TIME ZONE IN HOURS:  HH.MM "; X!
  29. 1125 INPUT"LONGITUDE: DDD.MM ";LN!
  30. 1127 L5!=LN!:L5!=FNQ(L5!)
  31. 1132 F!=FNQ(F!)+FNQ(X!)
  32. 1135 INPUT"LATITUDE:   DD.MM ";LT#
  33. 1137 LA!=LT#:LA!=FNR(FNQ(LA!))
  34. 1138 PRINT:PRINT "Calculating..."
  35. 1140 IF F$="PM" THEN F!=F!+12
  36. 1145 JM = 12 * (Y + 4800) + M - 3:J# = (2 * (JM -  INT (JM / 12) * 12) + 7 + 365 * JM) / 12: REM  JULIAN DAY NUMBER ROUTINE
  37. 1150 JD# =  INT (J#) + D +  INT (JM / 48) - 32083
  38. 1151 IF M=7 OR M=12 THEN 1167
  39. 1153 IF JD# <= 2299171# THEN 1160
  40. 1155 JD# = JD# +  INT (JM / 4800) -  INT (JM / 1200) + 38
  41. 1160 T#=((JD#-2.41502E+06)+ F!/24- .5)/36525!
  42. 1165 OB!= FNR(23.4523- .0130125*T#):GOTO 1250
  43. 1167 JD#=JD#-1:GOTO 1153
  44. 1250 RA!=FNR(FNU((6.64607+2400.05*T#+.0000258*T#*T#+F!)*15-L5!)):REM RAMC IN RADIANS
  45. 1252 GOTO 2850
  46. 1400 REM MIDHEAVEN
  47. 1405 X!=ATN(TAN(RA!)/COS(OB!)):IF X!<0 THEN X!=X!+PI!
  48. 1410 IF RA!>PI! THEN X!=X!+PI!
  49. 1415 MC!=FNU(FND(X!)+SD!)
  50. 1420 REM ASCENDANT
  51. 1425 A1!=ATN(COS(RA!)/(-SIN(RA!)*COS(OB!)-TAN(LA!)*SIN(OB!))):IF A1!<0 THEN A1!=A1!+PI!
  52. 1430 IF COS(RA!)<0 THEN A1!=A1!+PI!
  53. 1435 A1!=FNU(FND(A1!)+SD!)
  54. 1735 REM PLACIDUS HOUSES
  55. 1740 Y!=0:MO=360:H(4)=FNU(MC!+180-SD!):H(1)=FNU(A1!-SD!)
  56. 1745 R1!=RA!+FNR(30):FF!=3:GOSUB 1770:H(5)=FNU(LO!+180)
  57. 1750 R1!=RA!+FNR(60):FF!=1.5:GOSUB 1770:H(6)=FNU(LO!+180):R1!=RA!+FNR(120):Y!=1
  58. 1755 GOSUB 1770:H(2)=LO!:R1!=RA!+FNR(150):FF!=3:GOSUB 1770:H(3)=LO!
  59. 1760 FOR I=1 TO 12:H(I)=FNU(H(I)+SD!):IF I>6 THEN H(I)=FNU(H(I-6)+180)
  60. 1765 C!=H(I):GOSUB 4190:H$(I)=A$:NEXT I:GOSUB 1800:RETURN
  61. 1770 X!=-1:IF Y!=1 THEN X!=1
  62. 1775 FOR I=1 TO 10:XX!=FNY(X!*SIN(R1!)*TAN(OB!)*TAN(LA!)):IF XX!<0 THEN XX!=XX!+PI!
  63. 1780 R2!=RA!+(XX!/FF!):IF Y!=1 THEN R2!=RA!+PI!-(XX!/FF!)
  64. 1785 R1!=R2!:NEXT I:LO!=ATN(TAN(R1!)/COS(OB!)):IF LO!<0 THEN LO!=LO!+PI!
  65. 1790 IF SIN(R1!)<0 THEN LO!=LO!+PI!
  66. 1795 LO!=FND(LO!):RETURN
  67. 1800 PRINT
  68. 1805 PRINT "PLACIDUS HOUSE CUSPS"
  69. 1810 PRINT "1  "+H$(1),"2  "+H$(2),"3  "+H$(3),CHR$(13);CHR$(10);"4  "+H$(4),"5  "+H$(5),"6  "+H$(6),CHR$(13);CHR$(10);"7  "+H$(7),"8  "+H$(8),"9  "+H$(9),CHR$(13);CHR$(10);"10 "+H$(10),"11 "+H$(11),"12 "+H$(12)
  70. 1811 RETURN
  71. 2850 REM SUN ELEMENTS
  72. 2852 DATA 358.4758,35999.0,-.0002,.01675,-.4E-4,0,1,101.2208,1.7192,.00045,0,0
  73. 2854 REM MERCURY ELEMENTS BEGIN WITH 102.2974
  74. 2856 DATA 0,0,0,0,102.2794,149472.515,0,.205614,.2E-4,0,.3871,28.7538,.3703,.0001
  75. 2858 REM VENUS ELEMENTS BEGIN WITH 212.6032
  76. 2860 DATA 47.1459,1.1852,.0002,7.009,.00186,0,212.6032,58517.8039,.0013,.00682
  77. 2862 DATA -.5E-4,0,.7233,54.3842,.5082,-.14E-2,75.7796,.8999,.4E-3
  78. 2864 REM MARS ELEMENTS BEGIN AT 319.5294
  79. 2866 DATA 3.3936,.1E-2,0,319.5294,19139.8585,.2E-3,.09331,.9E-4,0,1.5237,285.4318
  80. 2868 REM JUPITER ELEMENTS BEGIN AT 225.4928
  81. 2870 DATA 1.0698,.1E-3,48.7864,.77099,0,1.8503,-.7E-3,0,225.4928,3033.6879,0
  82. 2872 DATA .04838,-.2E-4,0,5.2029,273.393,1.3383,0,99.4198,1.0583,0,1.3097
  83. 2874 REM JUPITER HARMONIC TERMS BEGIN AT -.001
  84. 2876 DATA -.52E-2,0,-.001,-.0005,.,.0051,581.7,-9.7,-.0005,2510.7,-12.5
  85. 2878 DATA -.0026,1313.7,-61.4,.0013,2370.79,-24.6,-.0013,3599.3,37.7,-.001,2574.7
  86. 2880 DATA 31.4,-.00096,6708.2,-114.5,-.0006,5499.4,-74.97,-.0013,1419,54.2,.0006
  87. 2882 DATA 6339.3,-109,.0007,4824.5,-50.9,.0020,-.0134,.0127,-.0023,676.2,.9,.00045
  88. 2884 DATA 2361.4,174.9,.0015,1427.5,-188.8,.0006,2110.1,153.6,.0014,3606.8,-57.7
  89. 2886 DATA -.0017,2540.2,121.7,-.00099,6704.8,-22.3,-.0006,5480.2,24.5,.00096
  90. 2888 REM SATURN ELEMENTS BEGIN AT 174.2153
  91. 2890 DATA 1651.3,-118.3,.0006,6310.8,-4.8,.0007,4826.6,36.2,174.2153,1223.50796
  92. 2892 DATA 0,.05423,-.2E-3,0,9.5525,338.9117,-.3167,0,112.8261,.8259,0,2.4908
  93. 2894 REM SATURN HARMONIC TERMS BEGIN AT -.0009
  94. 2896 DATA -.0047,0,-.0009,.0037,0,.0134,1238.9,-16.4,-.00426,3040.9,-25.2,.0064
  95. 2898 DATA 1835.3,36.1,-.0153,610.8,-44.2,-.0015,2480.5,-69.4,-.0014,.0026,0,.0111
  96. 2900 DATA 1242.2,78.3,-.0045,3034.96,62.8,-.0066,1829.2,-51.5,-.0078,640.6,24.2
  97. 2902 DATA -.0016,2363.4,-141.4,.0006,-.0002,0,-.0005,1251.1,43.7,.0005,622.8
  98. 2904 REM URANUS ELEMENTS BEGIN AT 74.1757
  99. 2906 DATA 13.7,.0003,1824.7,-71.1,.0001,2997.1,78.2,74.1757,427.2742,0,.04682
  100. 2908 REM URANUS HARMONIC TERMS BEGIN AT -.0021
  101. 2910 DATA .00042,0,19.2215,95.6863,2.0508,0,73.5222,.5242,0,.7726,.1E-3,0,-.0021
  102. 2912 DATA -.0159,0,.0299,422.3,-17.7,-.0049,3035.1,-31.3,-.0038,945.3,60.1
  103. 2914 DATA -.0023,1227,-4.99,.0134,-.02186,0,.0317,404.3,81.9,-.00495,3037.9,57.3
  104. 2916 DATA .004,993.5,-54.4,-.0018,1249.4,79.2,-.0003,.0005,0,.0005,352.5,-54.99
  105. 2918 REM NEPTUNE ELEMENTS BEGIN AT 30.13294
  106. 2920 DATA .0001,3027.5,54.2,-.0001,1150.3,-88,30.13294,240.45516,0,.00913,-.00127
  107. 2922 REM NEPTUNE HARMONIC TERMS BEGIN AT .1832
  108. 2924 DATA 0,30.11375,284.1683,-21.6329,0,130.68415,1.1005,0,1.7794,-.0098,0,.1832
  109. 2926 DATA -.6718,.2726,-.1923,175.7,31.8,.0122,542.1,189.6,.0027,1219.4,178.1
  110. 2928 DATA -.00496,3035.6,-31.3,-.1122,.166,-.0544,-.00496,3035.3,58.7,.0961,177.1
  111. 2930 DATA -68.8,-.0073,630.9,51,-.0025,1236.6,78,.00196,-.0119,.0111,.0001
  112. 2932 REM PLUTO ELEMENTS BEGIN AT 229.781
  113. 2934 DATA 3049.3,44.2,-.0002,893.9,48.5,.00007,1416.5,-25.2,229.781,145.1781,0
  114. 2936 DATA .24797,.002898,0,39.539,113.5366,.2086,0,108.944,1.3739,0,17.1514
  115. 2938 REM PLUTO HARMONIC TERMS BEGIN AT -.0426
  116. 2940 DATA -.0161,0,-.0426,.073,-.029,.0371,372,-331.3,-.0049,3049.6,-39.2,-.0108
  117. 2942 DATA 566.2,318.3,.0003,1746.5,-238.3,-.0603,.5002,-.6126,.049,273.97,89.97
  118. 2944 DATA -.0049,3030.6,61.3,.0027,1075.3,-28.1,-.0007,1402.3,20.3,.0145,-.0928
  119. 2946 DATA .1195,.0117,302.6,-77.3,.00198,528.1,48.6,-.0002,1000.4,-46.1
  120. 3000 FOR I=1 TO 9:REM LOOP FOR PLANETS
  121. 3010 MO=2*PI!:REM MOD FUNCTION IN RADIANS
  122. 3015 GOSUB 3225:M!=FNU(S!):REM CALCULATE MEAN ANOMALY
  123. 3020 GOSUB 3225:E!=FND(S!):REM CALCULATE ECCENTRICITY
  124. 3025 EA!=M!:FOR A=1 TO 5:EA!=M!+E!*SIN(EA!):NEXT A:REM SOLVE KEPLER'S EQUATION
  125. 3030 READ AU!:REM SEMI-MAJOR AXIS
  126. 3035 E1!=.0172021/(AU!^1.5*(1-E!*COS(EA!))):REM BEGIN VELOCITY COORDINATES
  127. 3040 XW!=-(AU!*E1!)*SIN(EA!):YW!=(AU!*E1!)*(1-E!*E!)^.5*COS(EA!):REM PERIFOCAL COORD'S
  128. 3045 REM CALCULATE ARGUMENT OF PERIHELION AND ASCENDING NODE
  129. 3050 GOSUB 3225:AP!=S!:GOSUB 3225:AN!=S!
  130. 3055 GOSUB 3225:IN!=S!:REM CALCULATE INCLINATION
  131. 3060 X!=XW!:Y!=YW!:GOSUB 3300:REM ROTATE VELOCITY COORDINATES
  132. 3065 XH!=X!:YH!=Y!:ZH!=G!:REM HELIO ECLIPTIC RECTANGULAR VELOCITY COORDINATES
  133. 3070 REM STORE SUN VELOCITY COORDINATES
  134. 3075 MO=360:IF I=1 THEN XA!=-XH!:YA!=-YH!:ZA!=-ZH!:AB=0:GOTO 3095
  135. 3080 REM GEO COMPONENTS OF SOLAR VELOCITY
  136. 3085 XW!=XH!+XA!:YW!=YH!+YA!:ZW!=ZH!+ZA!
  137. 3090 REM PERIFOCAL COORDINATES FOR RECTANGULAR POSITION COORDINATES
  138. 3095 X!=AU!*(COS(EA!)-E!):Y!=AU!*SIN(EA!)*(1-E!*E!)^.5
  139. 3100 GOSUB 3300:XX!=X!:YY!=Y!:ZZ!=G!:REM ROTATE FOR RECTANGULAR POSITION COORD'S
  140. 3105 REM HARMONIC TERMS FOR OUTER PLANETS
  141. 3110 REM CORRECT RECTANGULAR COORDINATES
  142. 3115 IF I>4 THEN GOSUB 3270:XX!=XX!+T(2):YY!=YY!+T(1):ZZ!=ZZ!+T(3)
  143. 3120 XK!=(XX!*YH!-YY!*XH!)/(XX!*XX!+YY!*YY!):REM COMPUTE HELIO DAILY MOTION
  144. 3125 HDM!=FND(XK!):REM HELIO DAILY MOTION
  145. 3130 R$="  ":REM SET RETROGRADE STRING TO BLANK
  146. 3135 REM CONVERT HELIO RECTANGULAR TO SPHERICAL COORDINATES
  147. 3140 AB=0:BR!=0:GOSUB 3200:AB=1
  148. 3145 CH(I)=SS!:CL(I)=C!:REM STORE HELIO LONGITUDE & LATITUDE
  149. 3150 REM STORE EARTH/SUN COORDINATES
  150. 3155 IF I=1 THEN C$(1)="SUN":X1!=XX!:Y1!=YY!:Z1!=ZZ!:GOTO 3170
  151. 3160 XX!=XX!-X1!:YY!=YY!-Y1!:ZZ!=ZZ!-Z1!:REM HELIO TO GEO RECTANGULAR
  152. 3165 XK!=(XX!*YW!-YY!*XW!)/(XX!*XX!+YY!*YY!):REM GEO DAILY MOTION
  153. 3170 BR!=5.768300000000005D-03*SQR(XX!*XX!+YY!*YY!+ZZ!*ZZ!)*FND(XK!):REM ABERRATION
  154. 3175 IF XK!<0 THEN R$=" R":REM RETROGRADE CHECK
  155. 3180 REM CONVERT RECTANGULAR TO SPHERICAL
  156. 3185 GOSUB 3200:C(I)=SS!:M(I)=P!:IF XK!<0 THEN C(I)=-SS!
  157. 3190 NEXT I
  158. 3191 GOSUB 4675
  159. 3192 GOSUB 1400
  160. 3193 GOSUB 4950
  161. 3198 END
  162. 3199 REM RECTANGULAR TO SPHERICAL COORDINATES
  163. 3200 X!=XX!:Y!=YY!:GOSUB 3240:K!=A!:C!=FND(A!)+NU!+BR!:IF I=1 AND AB=1 THEN C!=FNU(C!+180)
  164. 3205 C!=FNU(C!+SD!):SS!=C!:Y!=ZZ!:X!=R!:GOSUB 3240:IF A!>.35 THEN A!=A!-2*PI!
  165. 3210 P!=FND(A!)
  166. 3215 GOSUB 4190:P$=Z$+R$:C!=P!:GOSUB 4190:IF AB=1 THEN F$(I)=P$ ELSE 3218
  167. 3218 RETURN
  168. 3220 REM ASSEMBLE ORBITAL ELEMENTS
  169. 3225 READ S!,S1!,S2!:S!=S!+S1!*T#+S2!*T#^2:S!=FNR(S!):RETURN
  170. 3229 REM POLAR TO RECTANGULAR COORDINATES
  171. 3230 IF A!=0 THEN A!=1.7E-09
  172. 3235 X!=R!*COS(A!):Y!=R!*SIN(A!):RETURN
  173. 3239 REM RECTANGULAR TO POLAR COORDINATES
  174. 3240 IF Y!=0 THEN Y!=1.7E-09
  175. 3245 R!=(X!*X!+Y!*Y!)^.5
  176. 3250 A!=ATN(Y!/X!):IF A!<0 THEN A!=A!+PI!
  177. 3255 IF Y!<0 THEN A!=A!+PI!
  178. 3260 RETURN
  179. 3265 REM CALCULATE HARMONIC TERMS FOR OUTER PLANETS
  180. 3270 K(5)=11:K(6)=5:K(7)=4:K(9)=4:K(8)=4:REM NUMBER OF HARMONIC TERMS FOR PLANET
  181. 3275 FOR IK=1 TO 3:IF I=5 AND IK=3 THEN T(3)=0:RETURN
  182. 3280 IF IK=3 THEN K(I)=K(I)-1
  183. 3284 REM ASSEMBLE TERMS
  184. 3285 GOSUB 3225:A!=0:FOR IJ=1 TO K(I):READ U!,V!,W!
  185. 3290 A!=A!+FNR(U!)*COS((V!*T#+W!)*PI!/180):NEXT IJ:T(IK)=FND(S!+A!):NEXT IK:RETURN
  186. 3295 REM ROTATE ROUTINE USED FOR POSITION AND VELOCITY COORDINATES
  187. 3300 GOSUB 3240:A!=A!+AP!:GOSUB 3230:D!=X!:X!=Y!:Y!=0:GOSUB 3240:A!=A!+IN!:GOSUB 3230:G!=Y!:Y!=X!:X!=D!
  188. 3305 GOSUB 3240:A!=A!+AN!:IF A!<O THEN A!=A!+2*PI!
  189. 3310 GOSUB 3230
  190. 3320 RETURN
  191. 4190 U! =  ABS (C!): REM  REMOVE NEGATION IF PRESENT
  192. 4195 Z3 =  INT (U!):Q =  INT (Z3 / 30) + 1: REM  'Q' IS ZODIAC SIGN NUMBER
  193. 4200 Z7 =  INT ( FNW((Z3 / 30 -  INT ( Z3 / 30 )) * 30)): REM  NUMBER OF DEGREES
  194. 4205 X$ =  RIGHT$ ( STR$ (Z7),2): IF Z7 < 10 THEN X$ = "0" +  RIGHT$ (X$,1)
  195. 4210 ZZ$ =  STR$ ( INT (((U! - Z3) * 60 + .5))): IF  VAL (ZZ$) < 10 THEN ZZ$ = "0" +  RIGHT$ (ZZ$,1): REM  STRING FOR MINUTES
  196. 4215 B$ =  MID$ (ZA$,Q * 2 - 1,2): REM  SELECTS ZODIAC STRING FROM ZA$
  197. 4220 A$ = "+": IF C! < 0 THEN A$ = "-": REM  SETS SIGN STRING FOR LATITUDE/DECLINATION
  198. 4225 D$ = A$ + X$ + " " +  RIGHT$ (ZZ$,2): REM  LATITUDE/DECLINATION STRING
  199. 4230  IF EQ = 1 THEN B$ = " ":X$ =  RIGHT$ (" " + STR$ (Z3),3): REM  FLAG FOR 360-DEGREE NOTATION
  200. 4235 Z$ =  LEFT$ (C$(I),2) + " " + X$ + B$ +  RIGHT$ (ZZ$,2): REM  PLANET AND POSITION STRING
  201. 4240 A$ =  RIGHT$ (Z$,6): REM  ZODIAC NOTATION STRING
  202. 4245 RETURN
  203. 4675 REM CONVERTS SECONDS TO DEGREES WITHIN 360 CIRCLE
  204. 4685 REM MOON & MOON'S NODE ROUTINE
  205. 4695 REM COMPUTE MEAN LUNAR LONGITUDE
  206. 4700 LL#=973563!+1732564379#*T#-4*T#*T#
  207. 4705 REM COMPUTE SUN'S MEAN LONGITUDE OF PERIGEE
  208. 4710 G#=1.0124E+06+6189*T#
  209. 4715 REM COMPUTE MEAN LUNAR NODE
  210. 4720 N#=933060!-6.96291E+06*T#+7.5*T#*T#
  211. 4725 MLN#= FNP(N#):REM MEAN LUNAR NODE
  212. 4730 REM COMPUTE MEAN LONGITUDE OF LUNAR PERIGEE
  213. 4735 G1#=1.20359E+06+14648523#*T#-37*T#*T#
  214. 4740 REM COMPUTE MEAN ELONGATION OF MOON FROM SUN
  215. 4745 D#=1.26266E+06+1602961611#*T#-5*T#*T#:M#=3600
  216. 4750 REM COMPUTE AUXILIARY ANGLES
  217. 4755 L#=(LL#-G1#)/M#:L1#=((LL#-D#)-G#)/M#:F#=(LL#-N#)/M#:D#=D#/M#:Y#=2*D#
  218. 4760 REM COMPUTE MOON'S PERTURBATIONS
  219. 4765 ML#=22639.6*FNS(L#)-4586.4*FNS(L#-Y#)
  220. 4770 ML#=ML#+2369.9*FNS(Y#)+769*FNS(2*L#)-669*FNS(L1#)
  221. 4775 ML#=ML#-411.6*FNS(2*F#)-212*FNS(2*L#-Y#)
  222. 4780 ML#=ML#-206*FNS(L#+L1#-Y#)+192*FNS(L#+Y#)
  223. 4785 ML#=ML#-165*FNS(L1#-Y#)+148*FNS(L#-L1#)-125*FNS(D#)
  224. 4790 ML#=ML#-110*FNS(L#+L1#)-55*FNS(2*F#-Y#)
  225. 4795 ML#=ML#-45*FNS(L#+2*F#)+40*FNS(L#-2*F#)
  226. 4800 G#=FNU((LL#+ML#)/M#):REM LUNAR LONGITUDE
  227. 4801 C!=G#:GOSUB 4190
  228. 4802 F$(I)=Z$
  229. 4803 PRINT:PRINT "POSITIONS OF SUN, MOON, AND PLANETS"
  230. 4804 PRINT F$(1),F$(4),F$(7),CHR$(13);CHR$(10);F$(10),F$(5),F$(8),CHR$(13);CHR$(10);F$(2),F$(6),F$(9),CHR$(13);CHR$(10);F$(3)
  231. 4805 REM COMPUTE LUNAR LATITUDE
  232. 4810 MB!=18461.5*FNS(F!)+1010*FNS(L!+F!)-999*FNS(F!-L!)
  233. 4815 MB!=MB!-624*FNS(F!-Y!)+199*FNS(F!+Y!-L!)
  234. 4820 MB!=MB!-167*FNS(L!+F!-Y!)+117*FNS(F!+Y!)
  235. 4825 MB!=MB!+62*FNS(2*L!+F!)-33*FNS(F!-Y!-L!)
  236. 4830 MB!=MB!-32*FNS(F!-2*L!)-30*FNS(L1!+F!-Y!)
  237. 4835 MB!=FNP(MB!):REM LUNAR LATITUDE
  238. 4840 REM COMPUTE TRUE LUNAR NODE
  239. 4845 TN!=N!+5392*FNS(2*F!-Y!)-541*FNS(L1!)-442*FNS(Y!)
  240. 4850 TN!=TN!+423*FNS(2*F!)-291*FNS(2*L!-2*F!)
  241. 4855 TN!=FNU(TN!/M!):REM TRUE LUNAR NODE
  242. 4860 RETURN
  243. 4950 PRINT:PRINT "PRINT HARDCOPY (Y OR N)?"
  244. 4955 PRINT
  245. 4960 OP$=INKEY$
  246. 4965 IF OP$<>"y" AND OP$<>"Y" AND OP$<>"n" AND OP$<>"N" THEN 4960
  247. 4970 IF OP$="N" OR OP$="n" GOTO 5100
  248. 4975 PRINT "IF PRINTER IS READY, PRESS THE SPACE BAR..."
  249. 4980 IF INKEY$="" THEN 4980
  250. 4985 WIDTH LPRINT 75
  251. 4990 LPRINT "DATE: "DA$;"    ";"TIME: "TI;TI$;"   ";"LONGITUDE: "LN!;"   ";"LATITUDE: "LT#
  252. 4995 LPRINT
  253. 5000 LPRINT "POSITIONS OF SUN, MOON, AND PLANETS"
  254. 5005 LPRINT F$(1),F$(4),F$(7),CHR$(13);CHR$(10);F$(10),F$(5),F$(8),CHR$(13);CHR$(10);F$(2),F$(6),F$(9),CHR$(13);CHR$(10);F$(3)
  255. 5010 LPRINT:LPRINT "PLACIDUS HOUSE CUSPS"
  256. 5015 LPRINT "1  "+H$(1),"2  "+H$(2),"3  "+H$(3),CHR$(13);CHR$(10);"4  "+H$(4),"5  "+H$(5),"6  "+H$(6),CHR$(13);CHR$(10);"7  "+H$(7),"8  "+H$(8),"9  "+H$(9),CHR$(13);CHR$(10);"10 "+H$(10),"11 "+H$(11),"12 "+H$(12)
  257. 5095 LPRINT:LPRINT
  258. 5100 PRINT:PRINT "CALCULATE ANOTHER BIRTHDATE (Y OR N)?"
  259. 5105 CALC$=INKEY$
  260. 5110 IF CALC$<>"y" AND CALC$<>"Y" AND CALC$<>"n" AND CALC$<>"N" THEN 5105
  261. 5115 IF CALC$="N" OR CALC$="n" GOTO 3198
  262. 5117 PRINT:PRINT
  263. 5120 CLEAR
  264. 5125 GOTO 999
  265. ND CALC$<>"n" AND CALC$<>"N" THEN 5105
  266. 5115 IF CALC$="N" OR CALC$="n" GOTO 3198
  267. 5117