home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / c64 / games / comet.c64 (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1993-04-06  |  4.9 KB  |  213 lines

  1. 10 REM -------- COMET EPHEMERIS -------
  2. 20 PI=3.14159
  3. 30 CO$="COMET HALLEY"
  4. 40 PH=1986.11
  5. 50 PL=170.011
  6. 60 AN=58.1453
  7. 70 PY=76.0081
  8. 80 SM=17.9435
  9. 90 EO=.967267
  10. 100 IO=162.239
  11. 110 REM -------------------------------
  12. 115 PRINT"[147]"
  13. 120 PRINT"              ";CO$
  14. 130 PRINT"- - - - - - - - - - - - - - - - - - - -"
  15. 140 PRINT"           EPHEMERIS FOR DATES"
  16. 150 PRINT"          BETWEEN 1946 AND 2026"
  17. 160 PRINT"             BY ROGER BROWNE"
  18. 170 REM -------------------------------
  19. 180 REM      INPUT THE DATE
  20. 190 REM -------------------------------
  21. 200 PRINT "INPUT YEAR"
  22. 210 INPUT Y
  23. 220 IF Y<1946 OR Y>2026 THEN GOTO 200
  24. 230 PRINT "INPUT MONTH"
  25. 240 INPUT M
  26. 250 IF M<1 OR M>12 THEN GOTO 230
  27. 260 PRINT "INPUT DAY"
  28. 270 INPUT D
  29. 280 PRINT
  30. 290 REM -------------------------------
  31. 300 REM    CALCULATIONS FOR THE COMET
  32. 310 REM -------------------------------
  33. 320 LET X=PH
  34. 330 IF Y>=1986 THEN Z=1984
  35. 340 IF Y<1986 THEN Z=1988
  36. 350 IFY>=1986 THEN S=0
  37. 360 IF Y<1986 THEN S=1
  38. 370 GOSUB 1780
  39. 380 DS=N
  40. 390 B=(360/PY)*(N/365.25)
  41. 400 K=B
  42. 410 GOSUB 1930
  43. 420 B=(K*PI)/180
  44. 430 E=B
  45. 440 Y1=EO
  46. 450 Q=E-(Y1*SIN(E))-B
  47. 460 IF ABS(Q)<=.000017 THEN GOTO 500
  48. 470 U=Q/(1-(Y1*COS(E)))
  49. 480 E=E-U
  50. 490 GOTO 450
  51. 500 V=(SQR((1+Y1)/(1-Y1))*TAN(E/2))
  52. 510 V=2*ATN(V)
  53. 520 V1=(V*180)/PI
  54. 530 L=V1+PL
  55. 540 R=SM*(1-(Y1*Y1))/(1+Y1*COS(V))
  56. 550 F=L-AN
  57. 560 F2=IO
  58. 570 F1=(F*PI)/180
  59. 580 F2=(F2*PI)/180
  60. 590 I=(SIN(F1)*SIN(F2))
  61. 600 I=ATN(I/SQR(-I*I+1))
  62. 610 P=ATN(TAN(F1)*COS(F2))
  63. 620 P1=(P*180)/PI+AN
  64. 630 IFF>=90 AND F<=270 THEN P1=P1+180
  65. 640 IF P1<0 THEN P1=P1+360
  66. 650 P=(P1*PI)/180
  67. 660 R2=R*COS(I)
  68. 670 REM -------------------------------
  69. 680 REM   CALCULATIONS FOR THE EARTH
  70. 690 REM -------------------------------
  71. 700 X=1975
  72. 710 IF Y>=X THEN Z=1972
  73. 720 IF Y<X THEN Z=1976
  74. 730 IFY>=X THEN S=0
  75. 740 IF Y<X THEN S=1
  76. 750 GOSUB 1780
  77. 760 T=(360/365.25)*(N/1.00004)
  78. 770 K=T
  79. 780 GOSUB 1930
  80. 790 T=K
  81. 800 T1=(T*PI)/180
  82. 810 C=0.01672
  83. 820 J=T+(360/PI)*C*SIN(T1-.051943)
  84. 830 J=J+99.5343
  85. 840 IF J>360 THEN J=J-360
  86. 850 IF J<0 THEN J=J+360
  87. 860 H=((J-102.51044)*PI)/180
  88. 870 R1=(1-C*C)/(1+C*COS(H))
  89. 880 REM -------------------------------
  90. 890 REM COMPUTE ECLIPTIC COORDINATES
  91. 900 REM -------------------------------
  92. 910 U1=((P1-J)*PI)/180
  93. 920 U2=((J-P1)*PI)/180
  94. 930 IF R2<R1 THEN GOTO 990
  95. 940 Q1=(R1*SIN(U1))
  96. 950 Q1=Q1/(R2-(R1*COS(U1)))
  97. 960 Q1=ATN(Q1)
  98. 970 Q2=(Q1*180)/PI+P1
  99. 980 GOTO 1030
  100. 990 Q3=(R2*SIN(U2))
  101. 1000 Q3=Q3/(R1-(R2*COS(U2)))
  102. 1010 Q3=ATN(Q3)
  103. 1020 Q2=(Q3*180)/PI+J+180
  104. 1030 IF Q2>360 THEN Q2=Q2-360
  105. 1040 IF Q2<0 THEN Q2=Q2+360
  106. 1050 Q4=(Q2*PI)/180
  107. 1060 Q5=(R2*TAN(I)*SIN(Q4-P))
  108. 1070 Q5=Q5/(R1*SIN(U1))
  109. 1080 Q5=ATN(Q5)
  110. 1090 REM ------------------------------
  111. 1100 REM CONVERT TO EQUATORIAL COORDS
  112. 1110 REM ------------------------------
  113. 1120 E1=.40893064
  114. 1130 L1=(SIN(Q5)*COS(E1))
  115. 1140 L1=L1+(COS(Q5)*SIN(E1)*SIN(Q4))
  116. 1150 M1=ATN(L1/SQR(-L1*L1+1))
  117. 1160 Y2=(M1*180)/PI
  118. 1170 B1=(TAN(Q4)*COS(E1))
  119. 1180 B1=B1-((TAN(Q5)*SIN(E1))/COS(Q4))
  120. 1190 G=ATN(B1)
  121. 1200 H1=(G*180)/PI
  122. 1210 I1=INT(Q2/90)
  123. 1220 J1=INT(H1/90)
  124. 1230 IF I1-J1=4 OR I1-J1=1 THEN H1=H1+360
  125. 1240 IF I1-J1=2 OR I1-J1=3 THEN H1=H1+180
  126. 1250 IF I1-J1=-4 THEN H1=H1+360
  127. 1260 IF I1-J1=-2 THEN H1=H1-180
  128. 1270 N1=H1/15
  129. 1280 W=INT((N1-INT(N1))*60+.5)
  130. 1290 IFW=60 THEN N1=N1+1
  131. 1300 IFW=60 THEN W=0
  132. 1310 K1=ABS(Y2)
  133. 1320 W1=INT((K1-INT(KK1))*60+.5)
  134. 1330 IF W1=60 THEN G1=G1+1
  135. 1340 IF W1=60 THEN W1=0
  136. 1350 G1=INT(K1)
  137. 1360 IF Y2<0 AND G1<1 THEN W1=-W1
  138. 1370 D1=R1*R1+R2*R2
  139. 1380 D1=D1-(2*R1*R2*COS(U1))
  140. 1390 D2=SQR(D1)
  141. 1400 R3=D2/COS(I)
  142. 1410 K9=R
  143. 1420 GOSUB 2040
  144. 1430 R=K9
  145. 1440 K9=R3/10
  146. 1450 GOSUB2040
  147. 1460 R3=K9*10
  148. 1470 M0=4.1:N=3.1
  149. 1480 IF DS<0 THEN M0=5:N=4.44
  150. 1490 MA=M0+5*.4343*LOG(R3)
  151. 1500 MA=MA+N*2.5*.4343*LOG(R)
  152. 1510 MA=(INT(10*MA))/10
  153. 1520 IF Y2<0 THEN G1=-G1
  154. 1530 REM ------------------------------
  155. 1540 REM     PRINT EPHEMERIS FOR DATE
  156. 1550 REM ------------------------------
  157. 1560 PRINT "--------------------------"
  158. 1570 PRINT "DATA FOR "+CO$
  159. 1580 PRINT "DATE: M/D/Y=";M;"/";D;"/";Y
  160. 1590 PRINT "DAYS TO PERIHELION ";INT(DS)
  161. 1600 PRINT
  162. 1610 PRINT "COORDINATES:"
  163. 1620 PRINT " RA:"; INT(N1);"HRS";W;"MIN"
  164. 1630 PRINT "DEC:"; G1;"DEG";W1;"MIN"
  165. 1640 PRINT
  166. 1650 PRINT "DISTANCES:"
  167. 1660 PRINT "COMET TO SUN"; R;"AU"
  168. 1670 PRINT "COMET TO EARTH";R3;"AU"
  169. 1680 PRINT
  170. 1690 PRINT "PREDICTED MAG";MA
  171. 1700 PRINT "--------------------------"
  172. 1710 PRINT "PRESS Y/N FOR ANOTHER DATE"
  173. 1720 GETK$:IF K$="Y" THEN GOTO 1740
  174. 1725 IF K$="N" THEN END
  175. 1730 GOTO 1720
  176. 1740 PRINT
  177. 1750 GOTO 200
  178. 1760 REM ------------------------------
  179. 1770 REM SUBROUTINE: DAYS TP PERIHELION
  180. 1780 A=(Y-Z)/4
  181. 1790 A1=INT(A+S)
  182. 1800 N=365*(Y-X+S)+A1
  183. 1810 IF INT(A)<>A THEN GOTO 1830
  184. 1820 IF (M=2 AND D<29) OR M=1 THEN N=N-1
  185. 1830 IF M>2 THEN GOTO 1870
  186. 1840 M2=M-1
  187. 1850 M2=31*M2
  188. 1860 GOTO 1890
  189. 1870 M2=M+1
  190. 1880 M2=INT(30.6*M2)-63
  191. 1890 N=N+M2+D-365*S
  192. 1900 RETURN
  193. 1910 REM ------------------------------
  194. 1920 REM PLACE BETWEEN 0 AND 360 DEG
  195. 1930 IF K<0 THEN GOTO 1950
  196. 1940 IF K>360 THEN GOTO 1980
  197. 1950 K=K+360
  198. 1960 IF K>=0 THEN GOTO 2010
  199. 1970 GOTO 1950
  200. 1980 K=K-360
  201. 1990 IF K<=360 THEN GOTO 2010
  202. 2000 GOTO 1980
  203. 2010 RETURN
  204. 2020 REM ------------------------------
  205. 2030 REM: ROUND OFF SUBROUTINE
  206. 2040 K9=K9*1000
  207. 2050 K9=INT(K9+.5)
  208. 2060 K9=K9/1000
  209. 2070 RETURN
  210. 59999 END
  211. 60000 OPEN15,8,15,"S0:COMET HALLEY":CLOSE15:SAVE"0:COMET HALLEY",8
  212.