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