home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d0xx / d013 / basicprogs.lha / halley.bas < prev    next >
Encoding:
BASIC Source File  |  1986-02-22  |  5.5 KB  |  213 lines
  1. 1     ' Comet ephemeris
  2. 2     gosub 10000
  3. 20    ' LET PI=3.1.159267
  4. 30    LET CO$="COMET HALLEY"
  5. 40    LET PH=1986.11
  6. 50    LET PL = 170.011
  7. 60    LET AN = 58.1453
  8. 70    LET PY = 76.0081
  9. 80    LET SM = 17.9435
  10. 90    LET EO = 0.967267
  11. 100   LET IO = 162.239
  12. 110   REM -------------------------
  13. 120   PRINT TAB (10);CO$
  14. 130   PRINT "- - - - - - - - - - - - - - -"
  15. 140   PRINT "   EPHEMERIS FOR DATES"
  16. 150   PRINT "    BETWEEN 1946 AND 2026"
  17. 160   PRINT "By Roger Browne"
  18. 165   Print "Adapted for Amiga by Tim Holloway":print
  19. 170   REM ========================
  20. 180   ' INPUT THE DATE
  21. 190   '
  22. 200   PRN=0: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   PRINT INVERSE (1);" Calculating ... "
  32. 300   ' CALCULATIONS FOR THE COMET
  33. 310   '
  34. 320   LET X = PH
  35. 330   IF Y >= 1986 THEN Z=1984
  36. 340   IF Y < 1986 THEN Z = 1988
  37. 350   IF Y >= 1986 THEN S=0
  38. 360   IF Y < 1986 THEN S = 1
  39. 370   GOSUB 1780
  40. 380   DS = N
  41. 390   B = (360/PY)*(N/365.25)
  42. 400   K=B
  43. 410   GOSUB 1930
  44. 420   B=(K*PI)/180
  45. 430   E=B
  46. 440   Y1=EO
  47. 450   Q=E-(Y1*SIN(E))-B
  48. 460   IF ABS(Q) <= 1.7E-05 THEN 500
  49. 470   U=Q/(1-(Y1*COS(E)))
  50. 480   E=E-U
  51. 490   GOTO 450
  52. 500   V=(SQR((1+Y1)/(1-Y1))*(SIN(E/2)/COS(E/2)))
  53. 510   V=2*ATN(V)
  54. 520   V1=(V*180)/PI
  55. 530   L=V1+PL
  56. 540   R=SM*(1-(Y1*Y1))/(1+Y1*COS(V))
  57. 550   F=L-AN
  58. 560   F2=IO
  59. 570   F1=F*PI/180
  60. 580   F2=F2*PI/180
  61. 590   I=SIN(F1)*SIN(F2)
  62. 600   I=ATN(I/SQR(-I*I+1))
  63. 610   P=ATN((SIN(F1)/COS(F1))*COS(F2))
  64. 620   P1=P*180/PI+AN
  65. 630   IF F>= 90 AND F<= 270 THEN P1=P1+180
  66. 640   IF P1 < 0 THEN P1=P1+360
  67. 650   P=P1*PI/180
  68. 660   R2=R*COS(I)
  69. 670   '===========================
  70. 680   ' Calculations for the Earth
  71. 690   '
  72. 700   X=1975
  73. 710   IF Y>= X THEN Z=1972
  74. 720   IF Y < X THEN Z=1976
  75. 730   IF Y>= X THEN S=0
  76. 740   IF Y<1976 THEN S=1
  77. 750   GOSUB 1780
  78. 760   T=(360/365.25)*(N/1.00004)
  79. 770   K=T
  80. 780   GOSUB 1930
  81. 790   T=K
  82. 800   T1=T*PI/180
  83. 810   C=0.01672
  84. 820   J=T+(360/PI)*C*SIN(T1-0.051943)
  85. 830   J=J+99.5343
  86. 840   IF J>360 THEN J=J-360
  87. 850   IF J<0 THEN J=J+360
  88. 860   h=((j-102.51044)*pi)/180
  89. 870   r1 = (1-c*c)/(1+c*cos(h))
  90. 880   REM ------------------------
  91. 890   REM Compute Ecliptic coordinates
  92. 900   REM ------------------------
  93. 910   U1=((P1-J)*PI)/180
  94. 920   U2=((J-P1)*PI)/180
  95. 930   IF (R2<R1) THEN 990
  96. 940   Q1=(R1*SIN(U1))
  97. 950   Q1=Q1/(R2-(R1*COS(U1)))
  98. 960   Q1=ATN(Q1)
  99. 970   Q2=(Q1*180)/PI+P1
  100. 980   GOTO 1030
  101. 990   Q3=R2*SIN(U2)
  102. 1000  Q3=Q3/(R1-(R2*COS(U2)))
  103. 1010  Q3=ATN(Q3)
  104. 1020  Q2=(Q3*180)/PI+J+180
  105. 1030  IF Q2>360 THEN Q2=Q2-360
  106. 1040  IF Q2<0 THEN Q2=Q2+360
  107. 1050  Q4=Q2*PI/180
  108. 1060  Q5=(R2*(SIN(I)/COS(I))*SIN(Q4-P))
  109. 1070  Q5=Q5/(R1*SIN(U1))
  110. 1080  Q5=ATN(Q5)
  111. 1090  REM ------------------------
  112. 1100  REM Convert to equatorial coordinates
  113. 1110  REM ------------------------
  114. 1120  E1=0.40893064
  115. 1130  L1=SIN(Q5)*COS(E1)
  116. 1140  L1=L1+COS(Q5)*SIN(E1)*SIN(Q4)
  117. 1150  M1=ATN(L1/SQR(-L1*L1+1))
  118. 1160  Y2=M1*180/PI
  119. 1170  B1=(SIN(Q4)/COS(Q4))*COS(E1)
  120. 1180  B1=B1-(((SIN(Q5)/COS(Q5))*SIN(E1))/COS(Q4))
  121. 1190  G=ATN(B1)
  122. 1200  H1=G*180/PI
  123. 1210  I1=INT(Q2/90)
  124. 1220  J1=INT(H1/90)
  125. 1230  IF (I1-J1)=4 OR (I1-J1)=1 THEN H1=H1+360
  126. 1240  IF (I1-J1)=2 OR (I1-J1)=3 THEN H1=H1+180
  127. 1250  IF (I1-J1)=-4 THEN H1=H1+360
  128. 1260  IF (I1-J1)=-2 THEN H1=H1-180
  129. 1270  LET N1=H1/15
  130. 1280  W=INT((N1-INT(N1))*60+0.5)
  131. 1290  IF W=60 THEN N1=N1+1
  132. 1300  IF W=60 THEN W=0
  133. 1310  K1=ABS(Y2)
  134. 1320  W1=INT((K1-INT(K1))*60+0.5)
  135. 1325  G1=INT(K1)
  136. 1330  IF W1=60 THEN G1=G1+1
  137. 1340  IF W1=60 THEN W1=0
  138. 1360  IF (Y2<0) AND (G1<1) THEN W1=-W1
  139. 1370  D1=R1*R1+R2*R2
  140. 1380  D1=D1-(2*R1*R2*COS(U1))
  141. 1390  D2=SQR(D1)
  142. 1400  R3=D2/COS(I)
  143. 1410  K9=R
  144. 1420  GOSUB 2040
  145. 1430  R=K9
  146. 1440  K9=R3/10
  147. 1450  GOSUB 2040
  148. 1460  R3=K9*10
  149. 1470  MO=4.1:N=3.1
  150. 1480  IF DS<0 THEN MO=5:N=4.44
  151. 1490  MA=MO+5*0.4343*LOG(R3)
  152. 1500  MA=MA+N*2.5*0.4343*LOG(R)
  153. 1510  MA=(INT(10*MA))/10
  154. 1520  IF Y2<0 THEN G1=-G1
  155. 1530  REM ------------------------
  156. 1540  REM Print ephemeris for date
  157. 1550  REM ------------------------
  158. 1560  PRINT "--------------------"
  159. 1570  PRINT "Data for ";CO$:PRINT
  160. 1575  gshape (200,150),pic%
  161. 1580  print "Date: ";M;"/";D;"/";Y
  162. 1590  print "Days to perihelion: ";int(ds)
  163. 1600  print
  164. 1610  print "Coordinates: epoch 1950"
  165. 1620  print "RA ..... ";INT(N1);" hrs ";W; " min"
  166. 1630  print "Dec .... ";G1;" deg ";w1;" min":print
  167. 1650  print "Distances:"
  168. 1660  print "Comet to sun: . ";R;" A.U."
  169. 1670  print "Comet to Earth: ";R3;" A.U."
  170. 1680  print
  171. 1690  print "Predicted mag.  ";MA
  172. 1700  print "--------------------"
  173. 1710  INPUT "Run another date";DATE$
  174. 1730  IF (DATE$<>"Y") AND (DATE$<> "y") THEN STOP
  175. 1740  GOTO 200
  176. 1770  REM ------------------------
  177. 1780  ' DAYS TO PERIHELION
  178. 1785  A=(Y-Z)/4
  179. 1790  A1=INT(A+S)
  180. 1800  N=365*(Y-X+S)+A1
  181. 1810  IF INT(A)<> A THEN 1830
  182. 1820  IF (M=2) AND (D<29) OR (M=1) THEN N=N-1
  183. 1830  IF M>2 THEN 1870
  184. 1840  M2=M-1
  185. 1850  M2=31*M2
  186. 1860  GOTO 1890
  187. 1870  M2=M+1
  188. 1880  M2=INT(30.6*M2)-63
  189. 1890  N=N+M2+D-365*S
  190. 1900  RETURN
  191. 1910  REM ------------------------
  192. 1920  REM PLACE BETWEEN 0 AND 360 DEG
  193. 1930  IF K<0 THEN 1950
  194. 1940  IF K>360 THEN 1980
  195. 1950  K=K+360
  196. 1960  IF K>=0 THEN 2010
  197. 1970  GOTO 1950
  198. 1980  K=K-360
  199. 1990  IF K<= 360 THEN 2010
  200. 2000  GOTO 1980
  201. 2010  RETURN
  202. 2020  REM ------------------------
  203. 2030  REM ROUND OFF SUBROUTINE
  204. 2040  K9=K9*1000
  205. 2050  K9=INT(K9+0.5)
  206. 2060  K9=K9/1000
  207. 2070  RETURN
  208. 10000 ' AMIGA GRAPHICS - OPTIONAL (TFH)
  209. 10005 scnclr
  210. 10010 dim pic%(138):bload "HALLEY.PIC",varptr(pic%(0))
  211. 10020 gshape (220,20),pic%
  212. 10030 return
  213.