home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / basic / astrmenu.lbr / MOONS.BZS / MOONS.BAS
BASIC Source File  |  1987-04-26  |  2KB  |  83 lines

  1. 1 PRINT "From the March 1985 SKY & TELESCOPE, pp. 254-5."
  2. 2 PRINT
  3. 3 PRINT "This program calculates the times of new and full Moons in a given"
  4. 5 PRINT "year.  The Julian calendar is used for years 1582 and earlier, and"
  5. 6 PRINT "the Gregorian calendar thereafter."
  6. 7 PRINT
  7. 8 PRINT "INPUT:  Year." : PRINT
  8. 9 PRINT "OUTPUT:  List of new and full moons (UT)." : PRINT
  9. 10 REM    NEW AND FULL MOONS
  10. 12 REM
  11. 14 REM
  12. 16 R1=3.14159265#/180: U=0
  13. 18 INPUT "YEAR ";Y
  14. 19 G=1 : IF Y<1583 THEN G=0
  15. 20 PRINT
  16. 22 K0=INT((Y-1900)*12.3685)
  17. 24 T=(Y-1899.5)/100
  18. 26 T2=T*T: T3=T*T*T
  19. 28 J0=2415020!+29*K0
  20. 30 F0=.0001178*T2-1.55E-07*T3
  21. 32 F0=F0+.75933+.53058868#*K0
  22. 34 F0=F0-8.370001E-04*T-.000335*T2
  23. 36 J=J+INT(F): F=F-INT(F)
  24. 38 M0=K0*.08084821133#
  25. 40 M0=360*(M0-INT(M0))+359.2242
  26. 42 M0=M0-.0000333*T2
  27. 44 M0=M0-3.47E-06*T3
  28. 46 M1=K0*.07171366128#
  29. 48 M1=360*(M1-INT(M1))+306.0253
  30. 50 M1=M1+.0107306*T2
  31. 52 M1=M1+1.236E-05*T3
  32. 54 B1=K0*.08519585128#
  33. 56 B1=360*(B1-INT(B1))+21.2964
  34. 58 B1=B1-.0016528*T2
  35. 60 B1=B1-2.39E-06*T3
  36. 62 FOR K9=0 TO 28
  37. 64 J=J0+14*K9: F=F0+.765294*K9
  38. 66 K=K9/2
  39. 68 M5=(M0+K*29.10535608#)*R1
  40. 69 M6=(M1+K*385.81691806#)*R1
  41. 70 B6=(B1+K*390.67050646#)*R1
  42. 71 F=F-.4068*SIN(M6)
  43. 72 F=F+(.1734-.000393*T)*SIN(M5)
  44. 73 F=F+.0161*SIN(2*M6)
  45. 74 F=F+.0104*SIN(2*B6)
  46. 75 F=F-.0074*SIN(M5-M6)
  47. 76 F=F-.0051*SIN(M5+M6)
  48. 77 F=F+.0021*SIN(2*M5)
  49. 78 F=F+.001*SIN(2*B6-M6)
  50. 81 F=F+.5/1440
  51. 82 J=J+INT(F): F=F-INT(F)
  52. 84 IF U=0 THEN PRINT " NEW MOON ";
  53. 86 IF U=1 THEN PRINT "FULL MOON ";
  54. 88 GOSUB 920
  55. 90 U=U+1: IF U=2 THEN U=0
  56. 92 NEXT
  57. 94 RUN"ASTRMENU.BAS"
  58. 900 REM JD --> CALENDAR
  59. 905 REM
  60. 910 INPUT "J,F ";J,F
  61. 915 INPUT "JC (0) OR GC (1) ";G
  62. 920 F=F+.5
  63. 925 IF F<1 THEN 935
  64. 930 F=F-1 : J=J+1
  65. 935 IF G=1 THEN 945
  66. 940 A=J : GOTO 955
  67. 945 A1=INT((J/36524.25)-51.12264)
  68. 950 A=J+1+A1-INT(A1/4)
  69. 955 B=A+1524
  70. 960 C=INT((B/365.25)-.3343)
  71. 965 D=INT(365.25*C)
  72. 970 E=INT((B-D)/30.61)
  73. 975 D=B-D-INT(30.61*E)+F
  74. 980 M=E-1 : Y=C-4716
  75. 985 IF E>13.5 THEN M=M-12
  76. 990 IF M<2.5 THEN Y=Y+1
  77. 993 D1=INT(D) : H=24*(D-D1)
  78. 994 H1=INT(H) : M9=INT(60*(H-H1))
  79. 995 PRINT USING "####_ ";Y; : PRINT USING "##_ ";M; : PRINT USING "##";D1;
  80. 996 PRINT TAB(25) USING "##";H1; :PRINT "h "; :PRINT USING "##";M9; :PRINT "m"
  81. 997 RETURN
  82.  "##_ ";M; : PRINT USING "##";D1;
  83. 996 PRINT TAB(25) USING "##";H1; :P