10 REM PLNET.ECB 100 REM .....PLANET.......LAST REV. 05-06-80 R.E.H. 110 REM . CONVERTED FROM MERITSS LIB. on 5/7/75 BY J. STEWART 120 REM . BY DAVID E. LAIRD -- CINCINNATI COUNTRY DAY SCHOOL 130 REM . 6905 GIVEN ROAD, CINCINNATI OHIO 45243 140 REM . DEFINE ARCSIN, ARCCOS 150 REM 160 REM . BY DAVID E. LAIRD -- CINCINNATI COUNTRY DAY SCHOOL 170 REM . 6905 GIVEN ROAD, CINCINNATI OHIO 45243 180 REM . REVISED 7/74 (M. OLSON) 190 REM . REVISED 10/16/74 (P. MURPHY) 200 REM . DEFINE ARCSIN, ARCCOS 210 LET K$="&K": LET J$="&J": PRINT K$;J$;J$;J$ 220 PRINT TAB(15);"+:+ P L A N E T +:+" 230 PRINT J$;J$;J$ 240 PRINT " PROGRAM TO CALCULATE PLANET POSITIONS." 250 PRINT "*ENTER* 4 PARAMETERS FOR THE REPORT." 260 PRINT 270 DEF FNS(X)=ATN(X/SQR(1-X*X)) 280 DEF FNC(X)=ATN(SQR(1-X*X)/X) 290 LET C=1.74533E-02 300 LET P=3.14159 310 LET O1=.397835 320 LET O2=.917457 330 REM . STATION CONSTANTS 340 LET L1=45*C 350 LET L2=93*C 360 LET Z=6 370 REM . STORE ELEMENTS (E) for 1-4-72 angles in radians. 380 DIM E(7,7) 390 FOR I=1 TO 7 400 FOR J=1 TO 7 410 READ E(I,J) 420 NEXT J 430 NEXT I 440 DATA .387099,.205629,.122247,.837907,1.34446,7.14248E-02 450 DATA 1.61829,.723332,.006786,5.92428E-02,1.33404,2.28966 460 DATA 2.79624E-02,4.00427 470 DATA 1,.016721,0,0,1.78848,1.72028E-02,4.46106E-03 480 DATA 1.52369,.09338,.032286,.861277,5.85659 490 DATA 9.1461E-03,1.07404 500 DATA 5.20318,4.81174E-02,2.27909E-02,1.7482,.240698 510 DATA 1.45006E-03,4.37604 520 DATA 9.51623,5.29012E-02,.043443,1.9798,1.6247 530 DATA 5.86066E-04,5.83213 540 DATA .5072,0,1.0657,2.48465,2.01865,0,0 550 REM . GET DATE AND COMPUTE DAYS SINCE JAN 4, 1972 560 PRINT "ENTER DAY, MONTH, YEAR, HOUR ---=>"; 570 INPUT T1,T2,T3,H1 580 IF T3>1900 THEN 600 590 LET T3=T3+1900 600 LET T5=(T3-1972)*365 610 LET T5=T5+INT((T3-1973)/4)+1 620 LET T5=T5+(T2-1)*30+INT(T2*.57)+T1-4 630 IF T2<3 THEN 670 640 LET T5=T5-2 650 IF INT(T3/4)<>T3/4 THEN 670 660 LET Y9=E(3,1)*SIN(E(3,7))-E(7,1)*COS(E(7,4))*SIN(E(7,7)) 670 LET D=T5+(H1+Z)/24 680 PRINT 690 REM . SOLVE KEPLER7 THEN 750 720 GOSUB 1880 730 GOTO 870 740 REM . COMPUTE MEAN ANOMALY FOR DATE 750 LET E(I,7)=E(I,7)+E(I,6)*D 760 LET T1=E(I,7) 770 LET T2=E(I,7)+SIN(T1)*E(I,2) 780 IF ABS(T2-T1)<=.00001 THEN 810 790 LET T1=T2 800 GOTO 770 810 LET T3=0 815 IF 1-E(I,2)<>0 THEN LET T3=SQR((1+E(I,2))/(1-E(I,2))) 820 LET T4=2*ATN(T3*TAN(T2/2)) 830 IF T4>=0 THEN 850 840 LET T4=T4+2*P 850 LET E(I,7)=T4 860 LET E(I,1)=E(I,1)*(1-COS(T2)*E(I,2)) 870 REM . COMPUTE LATITUDE AND LONGITUDE 880 LET T1=E(I,5)-E(I,4) 890 LET Y9=SIN(E(I,7)+T1)*COS(E(I,3)) 900 LET X9=COS(E(I,7)+T1) 910 GOSUB 2010 920 LET E(I,7)=A+E(I,4) 930 LET E(I,4)=ATN(SIN(E(I,7)-E(I,4))*TAN(E(I,3))) 940 NEXT I 950 GOTO 1020 960 GOSUB 1640 970 PRINT 980 PRINT "DISTANCE OF COMET FROM SUN (A.U.) =";E(7,1) 990 PRINT "DISTANCE OF COMET FROM EARTH =";D9 1000 PRINT "MAGNITUDE ESTIMATE 0",INT(M8*10+.5)/10 1010 PRINT 1020 REM . COMPUTE GEOCENTRIC RECT EQ COORD OF SUN 1030 LET C1=-E(3,1)*COS(E(3,7)) 1040 LET C2=-E(3,1)*SIN(E(3,7))*O2 1050 LET C3=-E(3,1)*SIN(E(3,7))*O1 1060 REM . COMPUTE RA _ DEC -- E(I,1) AND E(I,2) 1070 PRINT "PLANET";TAB(22);"R. A.";TAB(45);"DECLINATION" 1080 PRINT 1090 FOR I=1 TO 6 1100 IF I<>3 THEN 1130 1110 LET E(I,4)=-E(I,4) 1120 LET E(I,7)=E(I,7)+P 1130 LET T1=FNS(O2*SIN(E(I,4))+O1*COS(E(I,4))*SIN(E(I,7))) 1140 LET Y9=(-O1*SIN(E(I,4))+O2*COS(E(I,4))*SIN(E(I,7)))/COS(T1) 1150 LET X9=COS(E(I,4))*COS(E(I,7))/COS(T1) 1160 LET X9=E(I,1)*COS(T1)*X9+C1 1170 LET Y9=E(I,1)*COS(T1)*Y9+C2 1180 LET T3=E(I,1)*SIN(T1)+C3 1190 GOSUB 2010 1200 LET E(I,1)=A 1210 LET T2=T3/SQR(X9*X9+Y9*Y9+T3*T3) 1220 LET E(I,2)=FNS(T2) 1230 GOSUB 1720 1240 LET K(I)=E(I,1)/(C*15) 1250 LET V(I)=E(I,2)/C 1260 LET W(I)=K(I)-INT(K(I)) 1270 LET W(I)=W(I)*60 1280 LET N(I)=ABS(V(I))-INT(ABS(V(I))) 1290 LET N(I)=N(I)*60 1300 PRINT %6I;INT(K(I));" HR. ";%5F1;W(I);" MIN."; 1320 PRINT TAB(35);%12I;INT(ABS(V(I)))*SGN(V(I));" DEG. "; 1330 PRINT %5F1;N(I);" MIN." 1340 NEXT I 1350 PRINT 1360 PRINT 1370 PRINT "PLANET";TAB(19);"AZMUTH";TAB(34);"ALTITUDE" 1380 PRINT 1390 REM . TRANSFORM TO AZIMUTH _ ALTITUDE 1400 LET S0=1.79267 1410 LET S=S0+D*1.72028E-02+(H1+Z)*15*C-L2 1420 FOR I=1 TO 6 1430 LET H=S-E(I,1) 1440 LET Y=SIN(E(I,2))*SIN(L1)+COS(E(I,2))*COS(H)*COS(L1) 1450 LET A2=FNS(Y) 1460 LET Y9=-COS(E(I,2))*SIN(H)/COS(A2) 1470 LET X9=(SIN(E(I,2))*COS(L1)-COS(E(I,2))*COS(H)*SIN(L1))/COS(A2) 1480 GOSUB 2010 1490 LET E(I,3)=A2 1500 LET E(I,4)=A 1510 GOSUB 1720 1520 PRINT %10F3;E(I,4)/C;" DEG.";TAB(25); 1530 PRINT %14F4;E(I,3)/C 1540 NEXT I 1550 PRINT 1560 PRINT 1570 PRINT "(-1 TO STOP) ... NEW HOUR ---=>"; 1580 INPUT (2,0)H1 1590 PRINT 1600 IF H1<0 THEN 2120 1610 IF H1<99 THEN 1410 1620 RESTORE 1630 GOTO 370 1640 REM . COMPUTE DELTA AND MAGNITUDE OF COMET 1650 LET X9=E(3,1)*COS(E(3,7))-E(7,1)*COS(E(7,4))*COS(E(7,7)) 1670 LET Z9=E(7,1)*SIN(E(7,4)) 1680 LET D9=SQR(X9*X9+Y9*Y9+Z9*Z9) 1690 LET M8=8+2.17147*LOG(D9)+4.34294*LOG(E(7,1)) 1700 LET M9=8+2.17147*LOG(D9)+4.34294*LOG(E(7,1)) 1710 RETURN 1720 REM . PLANET NAMES 1730 IF I<>1 THEN 1750 1740 PRINT "MERCURY "; 1750 IF I<>2 THEN 1770 1760 PRINT "VENUS "; 1770 IF I<>3 THEN 1790 1780 PRINT "SUN "; 1790 IF I<>4 THEN 1810 1800 PRINT "MARS "; 1810 IF I<>5 THEN 1830 1820 PRINT "JUPITER "; 1830 IF I<>6 THEN 1850 1840 PRINT "SATURN "; 1850 IF I<>7 THEN 1870 1860 PRINT "BRADFIELD "; 1870 RETURN 1880 REM . SUBROUTINE FOR ANOMALY AND RADIUS VECTOR OF COMET 1890 LET J1=1320.5+D 1900 LET J2=2125.7 1910 LET M1=5.16063E-02*ABS(J1-J2)/(2*E(I,1))^1.5 1920 LET M2=ATN(1/M1) 1930 LET M1=(1/TAN(M2/2))^(1/3) 1940 LET M3=ATN(1/M1) 1950 LET M1=2/(TAN(2*M3)) 1960 LET E(I,7)=2*ATN(M1) 1970 IF J1>J2 THEN 1990 1980 LET E(I,7)=-E(I,7) 1990 LET E(I,1)=2*E(I,1)/(1+COS(E(I,7))) 2000 RETURN 2010 REM . FOUR-QUAD ARCTAN 2020 LET A=ATN(Y9/X9) 2030 IF X9<0 THEN 2060 2040 IF Y9<0 THEN 2060 2050 RETURN 2060 IF X9<=0 THEN 2080 2070 IF Y9<0 THEN 2100 2080 LET A=A+P 2090 RETURN 2100 LET A=A+2*P 2110 RETURN 2120 PRINT "....THE END...." 2130 END