980 DATA SUN,MER,VEN,MAR,JUP,SAT,URA,NEP,PLU,MOO 999 REM UTILITIES 1001 DIM H(12),H$(12),C$(12),F$(10) 1003 PI# = 3.14159265#: REM DEFINE `PI' 1005 DEF FN R(X#) = PI# / 180 * X#: REM CONVERTS DEGREES TO RADIANS 1007 ZA$ = "ARTAGECALEVILISCSACPAQPI" 1010 DEF FN D(X#) = 180 / PI# * X#: REM CONVERTS RADIANS TO DEGREES 1015 DEF FN Q(X#) = SGN (X#) * ( INT ( ABS (X#)) + ( ABS (X#) - INT ( ABS (X#))) * 100 / 60): REM CONVERTS DEGREES/MINUTES TO DEGREES DECIMAL 1020 DEF FN U(X#) = X# - ( INT (X# / MO) * MO):MO = 360: REM MODULUS FUNCTION, RETURNS RESULT WITHIN CIRCLE 1025 DEF FN W(X#) = INT (X# * 100 + .5) / 100: REM ROUNDS OFF TO TWO DECIMAL PLACES 1030 DEF FN X(X#) = ATN (X# / SQR (1 - X# * X#)): REM ARCSINE FUNCTION 1035 DEF FN Y(X#) = ATN ( SQR (1 - X# * X#) / X#): REM ARCCOSINE FUNCTION 1040 DEF FN S(X#) = SIN (PI# / 180 * X#): REM SINE FUNCTION WHEN WORKING WITH DEGREES 1045 DEF FN C(X#) = COS (PI# / 180 * X#): REM COSINE FUNCTION WHEN WORKING WITH DEGREES 1050 DEF FN T(X#) = TAN (PI# / 180 * X#): REM TANGENT FUNCTION WHEN WORKING WITH DEGREES 1055 FOR I = 1 TO 10: READ C$(I): NEXT I: REM FILL PLANET NAME ARRAY 1090 INPUT"DATE: MM.DDYYYY "; A$ 1095 M= VAL(MID$(A$,1,2)) 1100 D= VAL(MID$(A$,4,2)) 1105 Y= VAL(MID$(A$,6,5)) 1110 INPUT"AM*PM "; F$ 1115 INPUT"TIME: HH.MM "; F# 1120 INPUT"TIME ZONE IN HOURS: HH.MM "; X# 1125 INPUT"LONGITUDE: DDD.MM "; L5#: L5#=FNQ(L5#) 1130 ST#=X#*15:MLD#=(L5#-ST#)*.0666667:F#=FNQ(F#)+FNQ(X#)+MLD# 1135 INPUT"LATITUDE: DD.MM "; LA#:LA#=FNR(FNQ(LA#)) 1137 PRINT:PRINT "Calculating..." 1140 IF F$="PM" THEN F#=F#+12 1145 IM = 12 * (Y + 4800) + M - 3:J# = (2 * (IM - INT (IM / 12) * 12) + 7 + 365 * IM) / 12: REM JULIAN DAY NUMBER ROUTINE 1150 JD# = INT (J#) + D + INT (IM / 48) - 32083: IF JD# < = 2299171# THEN 1160 1155 JD# = JD# + INT (IM / 4800) - INT (IM / 1200) + 38 1160 T#=((JD#-2415020#)+ F#/24- .5)/36525# 1165 OB#= FNR(23.452294#- .0130125*T#) 1250 RA#=FN R(FN U((6.6460656#+2400.0513#*T#+.0000258*T#*T#+F#)*15-L5#)):REM RAMC IN RADIANS 1252 GOTO 2850 1400 REM MIDHEAVEN 1405 X#=ATN(TAN(RA#)/COS(OB#)):IF X#<0 THEN X#=X#+PI# 1410 IF RA#>PI# THEN X#=X#+PI# 1415 MC#=FN U(FN D(X#)+SD#) 1420 REM ASCENDANT 1425 AS#=ATN(COS(RA#)/(-SIN(RA#)*COS(OB#)-TAN(LA#)*SIN(OB#))):IF AS#<0 THEN AS#=AS#+PI# 1430 IF COS(RA#)<0 THEN AS#=AS#+PI# 1435 AS#=FN U(FN D(AS#)+SD#) 1735 REM PLACIDUS HOUSES 1740 DEF FN Y(X#)=ATN(SQR(1-X#*X#)/X#):Y#=0:MO=360:H(4)=FN U(MC#+180-SD#):H(1)=FN U(AS#-SD#) 1745 R1#=RA#+FN R(30):FF#=3:GOSUB 1770:H(5)=FN U(LO#+180) 1750 R1#=RA#+FN R(60):FF#=1.5:GOSUB 1770:H(6)=FN U(LO#+180):R1#=RA#+FN R(120):Y#=1 1755 GOSUB 1770:H(2)=LO#:R1#=RA#+FN R(150):FF#=3:GOSUB 1770:H(3)=LO# 1760 FOR I=1 TO 12:H(I)=FN U(H(I)+SD#):IF I>6 THEN H(I)=FN U(H(I-6)+180) 1765 C#=H(I):GOSUB 4190:H$(I)=A$:NEXT I:GOSUB 1800:RETURN 1770 X#=-1:IF Y#=1 THEN X#=1 1775 FOR I=1 TO 10:XX#=FN Y(X#*SIN(R1#)*TAN(OB#)*TAN(LA#)):IF XX#<0 THEN XX#=XX#+PI# 1780 R2#=RA#+(XX#/FF#):IF Y#=1 THEN R2#=RA#+PI#-(XX#/FF#) 1785 R1#=R2#:NEXT I:LO#=ATN(TAN(R1#)/COS(OB#)):IF LO#<0 THEN LO#=LO#+PI# 1790 IF SIN(R1#)<0 THEN LO#=LO#+PI# 1795 LO#=FN D(LO#):RETURN 1800 PRINT 1805 PRINT "PLACIDUS HOUSE CUSPS":FOR I = 1 TO 12:PRINT I;" ";H$(I), 1807 CR=I/3:IF CINT(CR)-CR=0 THEN 1811 1809 NEXT I:RETURN 1811 PRINT CHR$(13):GOTO 1809 2850 REM SUN ELEMENTS 2852 DATA 358.4758,35999.0,-.0002,.01675,-.4E-4,0,1,101.2208,1.7192,.00045,0,0 2854 REM MERCURY ELEMENTS BEGIN WITH 102.2974 2856 DATA 0,0,0,0,102.2794,149472.515,0,.205614,.2E-4,0,.3871,28.7538,.3703,.0001 2858 REM VENUS ELEMENTS BEGIN WITH 212.6032 2860 DATA 47.1459,1.1852,.0002,7.009,.00186,0,212.6032,58517.8039,.0013,.00682 2862 DATA -.5E-4,0,.7233,54.3842,.5082,-.14E-2,75.7796,.8999,.4E-3 2864 REM MARS ELEMENTS BEGIN AT 319.5294 2866 DATA 3.3936,.1E-2,0,319.5294,19139.8585,.2E-3,.09331,.9E-4,0,1.5237,285.4318 2868 REM JUPITER ELEMENTS BEGIN AT 225.4928 2870 DATA 1.0698,.1E-3,48.7864,.77099,0,1.8503,-.7E-3,0,225.4928,3033.6879,0 2872 DATA .04838,-.2E-4,0,5.2029,273.393,1.3383,0,99.4198,1.0583,0,1.3097 2874 REM JUPITER HARMONIC TERMS BEGIN AT -.001 2876 DATA -.52E-2,0,-.001,-.0005,.,.0051,581.7,-9.7,-.0005,2510.7,-12.5 2878 DATA -.0026,1313.7,-61.4,.0013,2370.79,-24.6,-.0013,3599.3,37.7,-.001,2574.7 2880 DATA 31.4,-.00096,6708.2,-114.5,-.0006,5499.4,-74.97,-.0013,1419,54.2,.0006 2882 DATA 6339.3,-109,.0007,4824.5,-50.9,.0020,-.0134,.0127,-.0023,676.2,.9,.00045 2884 DATA 2361.4,174.9,.0015,1427.5,-188.8,.0006,2110.1,153.6,.0014,3606.8,-57.7 2886 DATA -.0017,2540.2,121.7,-.00099,6704.8,-22.3,-.0006,5480.2,24.5,.00096 2888 REM SATURN ELEMENTS BEGIN AT 174.2153 2890 DATA 1651.3,-118.3,.0006,6310.8,-4.8,.0007,4826.6,36.2,174.2153,1223.50796 2892 DATA 0,.05423,-.2E-3,0,9.5525,338.9117,-.3167,0,112.8261,.8259,0,2.4908 2894 REM SATURN HARMONIC TERMS BEGIN AT -.0009 2896 DATA -.0047,0,-.0009,.0037,0,.0134,1238.9,-16.4,-.00426,3040.9,-25.2,.0064 2898 DATA 1835.3,36.1,-.0153,610.8,-44.2,-.0015,2480.5,-69.4,-.0014,.0026,0,.0111 2900 DATA 1242.2,78.3,-.0045,3034.96,62.8,-.0066,1829.2,-51.5,-.0078,640.6,24.2 2902 DATA -.0016,2363.4,-141.4,.0006,-.0002,0,-.0005,1251.1,43.7,.0005,622.8 2904 REM URANUS ELEMENTS BEGIN AT 74.1757 2906 DATA 13.7,.0003,1824.7,-71.1,.0001,2997.1,78.2,74.1757,427.2742,0,.04682 2908 REM URANUS HARMONIC TERMS BEGIN AT -.0021 2910 DATA .00042,0,19.2215,95.6863,2.0508,0,73.5222,.5242,0,.7726,.1E-3,0,-.0021 2912 DATA -.0159,0,.0299,422.3,-17.7,-.0049,3035.1,-31.3,-.0038,945.3,60.1 2914 DATA -.0023,1227,-4.99,.0134,-.02186,0,.0317,404.3,81.9,-.00495,3037.9,57.3 2916 DATA .004,993.5,-54.4,-.0018,1249.4,79.2,-.0003,.0005,0,.0005,352.5,-54.99 2918 REM NEPTUNE ELEMENTS BEGIN AT 30.13294 2920 DATA .0001,3027.5,54.2,-.0001,1150.3,-88,30.13294,240.45516,0,.00913,-.00127 2922 REM NEPTUNE HARMONIC TERMS BEGIN AT .1832 2924 DATA 0,30.11375,284.1683,-21.6329,0,130.68415,1.1005,0,1.7794,-.0098,0,.1832 2926 DATA -.6718,.2726,-.1923,175.7,31.8,.0122,542.1,189.6,.0027,1219.4,178.1 2928 DATA -.00496,3035.6,-31.3,-.1122,.166,-.0544,-.00496,3035.3,58.7,.0961,177.1 2930 DATA -68.8,-.0073,630.9,51,-.0025,1236.6,78,.00196,-.0119,.0111,.0001 2932 REM PLUTO ELEMENTS BEGIN AT 229.781 2934 DATA 3049.3,44.2,-.0002,893.9,48.5,.00007,1416.5,-25.2,229.781,145.1781,0 2936 DATA .24797,.002898,0,39.539,113.5366,.2086,0,108.944,1.3739,0,17.1514 2938 REM PLUTO HARMONIC TERMS BEGIN AT -.0426 2940 DATA -.0161,0,-.0426,.073,-.029,.0371,372,-331.3,-.0049,3049.6,-39.2,-.0108 2942 DATA 566.2,318.3,.0003,1746.5,-238.3,-.0603,.5002,-.6126,.049,273.97,89.97 2944 DATA -.0049,3030.6,61.3,.0027,1075.3,-28.1,-.0007,1402.3,20.3,.0145,-.0928 2946 DATA .1195,.0117,302.6,-77.3,.00198,528.1,48.6,-.0002,1000.4,-46.1 3000 FOR I=1 TO 9:REM LOOP FOR PLANETS 3010 MO=2*PI#:REM MOD FUNCTION IN RADIANS 3015 GOSUB 3225:M#=FN U(S#):REM CALCULATE MEAN ANOMALY 3020 GOSUB 3225:E#=FN D(S#):REM CALCULATE ECCENTRICITY 3025 EA#=M#:FOR A=1 TO 5:EA#=M#+E#*SIN(EA#):NEXT A:REM SOLVE KEPLER'S EQUATION 3030 READ AU#:REM SEMI-MAJOR AXIS 3035 E1#=.0172021/(AU#^1.5*(1-E#*COS(EA#))):REM BEGIN VELOCITY COORDINATES 3040 XW#=-(AU#*E1#)*SIN(EA#):YW#=(AU#*E1#)*(1-E#*E#)^.5*COS(EA#):REM PERIFOCAL COORD'S 3045 REM CALCULATE ARGUMENT OF PERIHELION AND ASCENDING NODE 3050 GOSUB 3225:AP#=S#:GOSUB 3225:AN#=S# 3055 GOSUB 3225:IN#=S#:REM CALCULATE INCLINATION 3060 X#=XW#:Y#=YW#:GOSUB 3300:REM ROTATE VELOCITY COORDINATES 3065 XH#=X#:YH#=Y#:ZH#=G#:REM HELIO ECLIPTIC RECTANGULAR VELOCITY COORDINATES 3070 REM STORE SUN VELOCITY COORDINATES 3075 MO=360:IF I=1 THEN XA#=-XH#:YA#=-YH#:ZA#=-ZH#:AB=0:GOTO 3095 3080 REM GEO COMPONENTS OF SOLAR VELOCITY 3085 XW#=XH#+XA#:YW#=YH#+YA#:ZW#=ZH#+ZA# 3090 REM PERIFOCAL COORDINATES FOR RECTANGULAR POSITION COORDINATES 3095 X#=AU#*(COS(EA#)-E#):Y#=AU#*SIN(EA#)*(1-E#*E#)^.5 3100 GOSUB 3300:XX#=X#:YY#=Y#:ZZ#=G#:REM ROTATE FOR RECTANGULAR POSITION COORD'S 3105 REM HARMONIC TERMS FOR OUTER PLANETS 3110 REM CORRECT RECTANGULAR COORDINATES 3115 IF I>4 THEN GOSUB 3270:XX#=XX#+T(2):YY#=YY#+T(1):ZZ#=ZZ#+T(3) 3120 XK#=(XX#*YH#-YY#*XH#)/(XX#*XX#+YY#*YY#):REM COMPUTE HELIO DAILY MOTION 3125 HDM#=FN D(XK#):REM HELIO DAILY MOTION 3130 R$=" ":REM SET RETROGRADE STRING TO BLANK 3135 REM CONVERT HELIO RECTANGULAR TO SPHERICAL COORDINATES 3140 AB=0:BR#=0:GOSUB 3200:AB=1 3145 CH(I)=SS#:CL(I)=C#:REM STORE HELIO LONGITUDE & LATITUDE 3150 REM STORE EARTH/SUN COORDINATES 3155 IF I=1 THEN C$(1)="SUN":X1#=XX#:Y1#=YY#:Z1#=ZZ#:GOTO 3170 3160 XX#=XX#-X1#:YY#=YY#-Y1#:ZZ#=ZZ#-Z1#:REM HELIO TO GEO RECTANGULAR 3165 XK#=(XX#*YW#-YY#*XW#)/(XX#*XX#+YY#*YY#):REM GEO DAILY MOTION 3170 BR#=5.768300000000003D-03*SQR(XX#*XX#+YY#*YY#+ZZ#*ZZ#)*FN D(XK#):REM ABERRATION 3175 IF XK#<0 THEN R$=" R":REM RETROGRADE CHECK 3180 REM CONVERT RECTANGULAR TO SPHERICAL 3185 GOSUB 3200:C(I)=SS#:M(I)=P#:IF XK#<0 THEN C(I)=-SS# 3190 NEXT I 3191 GOSUB 4675 3192 GOSUB 1400 3193 END 3195 REM RECTANGULAR TO SPHERICAL COORDINATES 3200 X#=XX#:Y#=YY#:GOSUB 3240:K#=A#:C#=FN D(A#)+NU#+BR#:IF I=1 AND AB=1 THEN C#=FN U(C#+180) 3205 C#=FN U(C#+SD#):SS#=C#:Y#=ZZ#:X#=R#:GOSUB 3240:IF A#>.35 THEN A#=A#-2*PI# 3210 P#=FN D(A#) 3215 GOSUB 4190:P$=Z$+R$:C#=P#:GOSUB 4190:IF AB=1 THEN F$(I)=P$ ELSE 3218 3218 RETURN 3220 REM ASSEMBLE ORBITAL ELEMENTS 3225 READ S#,S1#,S2#:S#=S#+S1#*T#+S2#*T#^2:S#=FN R(S#):RETURN 3229 REM POLAR TO RECTANGULAR COORDINATES 3230 IF A#=0 THEN A#=1.7E-09 3235 X#=R#*COS(A#):Y#=R#*SIN(A#):RETURN 3239 REM RECTANGULAR TO POLAR COORDINATES 3240 IF Y#=0 THEN Y#=1.7E-09 3245 R#=(X#*X#+Y#*Y#)^.5 3250 A#=ATN(Y#/X#):IF A#<0 THEN A#=A#+PI# 3255 IF Y#<0 THEN A#=A#+PI# 3260 RETURN 3265 REM CALCULATE HARMONIC TERMS FOR OUTER PLANETS 3270 K(5)=11:K(6)=5:K(7)=4:K(9)=4:K(8)=4:REM NUMBER OF HARMONIC TERMS FOR PLANET 3275 FOR IK=1 TO 3:IF I=5 AND IK=3 THEN T(3)=0:RETURN 3280 IF IK=3 THEN K(I)=K(I)-1 3284 REM ASSEMBLE TERMS 3285 GOSUB 3225:A#=0:FOR IJ=1 TO K(I):READ U#,V#,W# 3290 A#=A#+FN R(U#)*COS((V#*T#+W#)*PI#/180):NEXT IJ:T(IK)=FN D(S#+A#):NEXT IK:RETURN 3295 REM ROTATE ROUTINE USED FOR POSITION AND VELOCITY COORDINATES 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# 3305 GOSUB 3240:A#=A#+AN#:IF A#