home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 23 / 64er_Magazin_Sonderheft_23_19xx_Markt__Technik_de_Disk_1_of_2_Side_A.d64 / mondkalender (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  6KB  |  195 lines
  1. 100 clr:gosub5000
  2. 110 :
  3. 120 p1=(NULL)/180:p2=180/(NULL):p3=(NULL)/648000
  4. 130 :
  5. 140 deffnas(x)=atn(x/sqr(1-x*x))
  6. 150 deffnac(x)=-atn(x/sqr(1-x*x))+(NULL)/2
  7. 160 deffnrd(x)=(x/360-int(x/360))*360
  8. 165 deffnmm(x)=(x/24-int(x/24))*24
  9. 170 :
  10. 180 input" [212]ag,[205]onat,[202]ahr ";da,mo,ye
  11. 190 print:input" [211]td,[205]in [[213][212]]   ";ho,mi
  12. 195 gosub5000
  13. 200 :
  14. 210 ut=ho+mi/60:mx=mo:yx=ye
  15. 220 ifmo<=2thenmx=mo+12:yx=ye-1
  16. 230 j1=int(365.25*yx)+int(30.6001*(mx+1))+1720981.5+da
  17. 240 j2=j1+ut/24
  18. 250 :
  19. 260 t1=(j2-2415020)/36525
  20. 270 t2=(j2-2451545)/36525
  21. 280 :
  22. 290 lm=fnrd(270.434164+480960*t1+307.883142*t1-.001133*t1*t1)*p1
  23. 300 mm=fnrd(296.104608+477000*t1+198.849108*t1+.009192*t1*t1)*p1
  24. 310 ak=fnrd(259.183275-1800*t1-134.142008*t1+.002078*t1*t1)*p1
  25. 320 ls=fnrd(279.696678+36000*t1+.768925*t1+.000303*t1*t1)*p1
  26. 330 ms=fnrd(358.475833+35640*t1+359.04975*t1-.00015*t1*t1)*p1
  27. 340 :
  28. 350 e(1)=22640*sin(mm)+769*sin(2*mm)+36*sin(3*mm)-125*sin(lm-ls)
  29. 360 e(2)=2370*sin(2*(lm-ls))-668*sin(ms)-412*sin(2*(lm-ak))
  30. 370 e(3)=212*sin(2*(lm-ls-mm))+4586*sin(2*(lm-ls)-mm)+192*sin(2*(lm-ls)+mm)
  31. 380 e(4)=165*sin(2*(lm-ls)-ms)+206*sin(2*(lm-ls)-mm-ms)-110*sin(mm+ms)
  32. 390 e(5)=148*sin(mm-ms)
  33. 400 :
  34. 410 fori=1to5:el=el+e(i):nexti
  35. 420 el=lm+el*p3
  36. 430 :
  37. 440 f(1)=18520*sin(el-ak+412*p3*sin(2*(lm-ak))+541*p3*sin(ms))
  38. 450 f(2)=-526*sin(2*ls-lm-ak)+44*sin(2*ls-lm-ak+mm)-31*sin(2*ls-lm-ak-mm)
  39. 460 f(3)=-23*sin(2*ls-lm-ak+ms)+11*sin(2*ls-lm-ak-ms)-25*sin(lm-ak-2*mm)
  40. 470 f(4)=21*sin(lm-ak-mm)
  41. 480 :
  42. 490 fori=1to4:eb=eb+f(i):nexti:eb=eb*p3
  43. 500 :
  44. 510 hp=3423+187*cos(mm)+10*cos(2*mm)+34*cos(2*(lm-ls)-mm)+28*cos(2*(lm-ls))
  45. 520 hp=hp+3*cos(2*(lm-ls)+mm)
  46. 530 hp=hp*p3
  47. 540 :
  48. 550 hm=fnas(.272493*sin(hp))
  49. 560 :
  50. 570 dm=6378.14/sin(hp)
  51. 580 :
  52. 600 se=(23.439291-.013004*t2)*p1
  53. 610 dk=fnas(sin(se)*cos(eb)*sin(el)+cos(se)*sin(eb))
  54. 620 ra=(cos(se)*cos(eb)*sin(el)-sin(se)*sin(eb))/(cos(dk)+cos(eb)*cos(el))
  55. 630 ra=2*atn(ra)
  56. 640 ra=ra-(ra<0)*2*(NULL)
  57. 650 :
  58. 660 gs=fnmm(6.656306+.0657098242*(j1-2445700.5)+1.0027379093*ut)
  59. 670 os=fnmm(gs+7/15)
  60. 680 sz=os*15*p1
  61. 690 gb=49.2*p1
  62. 700 er=6378.14
  63. 710 x=dm*cos(dk)*cos(ra)-er*cos(gb)*cos(sz)
  64. 720 y=dm*cos(dk)*sin(ra)-er*cos(gb)*sin(sz)
  65. 730 z=dm*sin(dk)-er*sin(gb)
  66. 740 dt=sqr(x*x+y*y+z*z)
  67. 750 d2=fnas((dm*sin(dk)-er*sin(gb))/dt)
  68. 760 r2=dt*cos(d2)+dm*cos(dk)*cos(ra)-er*cos(gb)*cos(sz)
  69. 770 r2=2*atn((dm*cos(dk)*sin(ra)-er*cos(gb)*sin(sz))/r2)
  70. 780 r2=r2-(r2<0)*2*(NULL)
  71. 790 :
  72. 800 sw=sz-r2
  73. 810 h=fnas(sin(gb)*sin(d2)+cos(gb)*cos(d2)*cos(sw))
  74. 820 a=2*atn((cos(d2)*sin(sw))/(cos(h)+sin(gb)*cos(d2)*cos(sw)-cos(gb)*sin(d2)))
  75. 830 az=a-(a<0)*2*(NULL)
  76. 835 :
  77. 840 z1$=right$(str$(100+da),2)+"."+right$(str$(100+mo),2)+"."
  78. 845 z1$=z1$+right$(str$(10000+ye),4)
  79. 850 z2$=right$(str$(100+ho),2)+"h"+right$(str$(100+mi),2)+"m"+" [213][212]"
  80. 855 :
  81. 860 print"  [196]atum  :[146] ";z1$:print
  82. 865 print"  [213]hrzeit:[146] ";z2$:print
  83. 867 printtab(10)" [210]ekt.[146]    [196]ekl.[146]   [197]ntfernung[146]"
  84. 870 rx=ra:gosub5100:print:print"  geoz. :[146] ";rx$;
  85. 875 r=dk:gosub5050:print"  ";n$;"  ";
  86. 877 printint(dm+.5)" km":print
  87. 880 rx=r2:gosub5100:print"  topoz.:[146] ";rx$;
  88. 885 r=d2:gosub5050:print"  ";n$;"  ";
  89. 887 printint(dt+.5)" km":print
  90. 890 r=az:gosub5050:print"  [193]zimut:[146]";n$;"  ";
  91. 900 r=h:gosub5050:print"  [200]oehe: [146]";n$;" [199]rd":print
  92. 905 r=hm*120:gosub5050:print"  [205]onddurchmesser:[146]";n$;" '":print
  93. 910 r=hp*120:gosub5050:print"  [197]rddurchmesser :[146]";n$;" '":print
  94. 915 print:printtab(20)"weiter mit [212]aste[146] ";
  95. 920 poke198,0:wait198,1:poke198,0
  96. 925 :
  97. 926 print"ja[146][144]"
  98. 930 t3=ye+(mo-1)/12+da/365
  99. 935 k(1)=int((t3-1900)*12.3685+.5)
  100. 940 k(2)=k(1)+.5
  101. 945 k(3)=k(1)+.25
  102. 950 k(4)=k(1)+.75
  103. 952 :
  104. 955 fori=1to4
  105. 960 t(i)=k(i)/1236.85
  106. 965 jd(i)=2415020.75933+29.53058868*k(i)+.0001178*t(i)*t(i)-.000000155*t(i)^3
  107. 970 jd(i)=jd(i)+.00033*sin((166.56+132.87*t(i)-.009173*t(i)*t(i))*p1)
  108. 975 m(i)=fnrd(359.2242+29.10535608*k(i)-.0000333*t(i)^2-.00000347*t(i)^3)*p1
  109. 980 mm(i)=fnrd(306.0253+385.81691806*k(i)+.0107306*t(i)^2+.00001236*t(i)^3)*p1
  110. 985 f(i)=fnrd(21.2964+390.67050646*k(i)-.0016528*t(i)^2-.00000239*t(i)^3)*p1
  111. 990 nexti
  112. 992 :
  113. 995 fori=1to2
  114. 1000 a1=(.1734-.000393*t(i))*sin(m(i))+.0021*sin(2*m(i))-.4068*sin(mm(i))
  115. 1005 a2=.0161*sin(2*mm(i))-.0004*sin(3*mm(i))+.0104*sin(2*f(i))
  116. 1010 a3=-.0051*sin(m(i)+mm(i))-.0074*sin(m(i)-mm(i))+.0004*sin(2*f(i)+m(i))
  117. 1015 a4=-.0004*sin(2*f(i)-m(i))-.0006*sin(2*f(i)+mm(i))+.001*sin(2*f(i)-mm(i))
  118. 1020 a5=.0005*sin(m(i)+2*mm(i))
  119. 1025 jd(i)=jd(i)+a1+a2+a3+a4+a5
  120. 1030 nexti
  121. 1032 :
  122. 1035 fori=3to4
  123. 1040 a1=(.1721-.0004*t(i))*sin(m(i))+.0021*sin(2*m(i))-.628*sin(mm(i))
  124. 1045 a2=.0089*sin(2*mm(i))-.0004*sin(3*mm(i))+.0079*sin(2*f(i))
  125. 1050 a3=-.0119*sin(m(i)+mm(i))-.0047*sin(m(i)-mm(i))+.0003*sin(2*f(i)+m(i))
  126. 1055 a4=-.0004*sin(2*f(i)-m(i))-.0006*sin(2*f(i)+mm(i))+.0021*sin(2*f(i)-mm(i))
  127. 1060 a5=.0003*sin(m(i)+2*mm(i))+.0004*sin(m(i)-2*mm(i))-.0003*sin(2*m(i)+mm(i))
  128. 1065 jd(i)=jd(i)+a1+a2+a3+a4+a5
  129. 1070 nexti
  130. 1075 jd(3)=jd(3)+.0028-.0004*cos(m(3))+.0003*cos(mm(3))
  131. 1080 jd(4)=jd(4)-.0028+.0004*cos(m(4))-.0003*cos(mm(4))
  132. 1082 :
  133. 1085 zt(1)=jd(1)
  134. 1090 zt(2)=jd(3)
  135. 1095 zt(3)=jd(2)
  136. 1100 zt(4)=jd(4)
  137. 1105 gosub5000
  138. 1110 print"  [205]ondphasen [146]":print
  139. 1115 print:x=zt(1):gosub5150
  140. 1120 print"  [206]eumond        :[146] ";z3$
  141. 1125 print:x=zt(2):gosub5150
  142. 1130 print"  [197]rstes [214]iertel :[146] ";z3$
  143. 1135 print:x=zt(3):gosub5150
  144. 1140 print"  [214]ollmond       :[146] ";z3$
  145. 1145 print:x=zt(4):gosub5150
  146. 1150 print"  [204]etztes [214]iertel:[146] ";z3$
  147. 1155 print:print
  148. 1160 printtab(5)"[197]phemeriden wiederholen  (1) [146][144]":print
  149. 1165 printtab(5)"[208]rogramm neu beginnen    (2) [146][144]":print
  150. 1167 printtab(5)"[208]rogramm beenden         (3) [146][144]"
  151. 1170 getw$:ifw$=""then1170
  152. 1175 ifw$="1"thengosub5000:goto860
  153. 1177 ifw$="2"then100
  154. 1179 ifw$="3"thenend
  155. 1180 goto1170
  156. 4999 end
  157. 5000 poke53281,14:poke53280,6:poke646,0
  158. 5005 printchr$(147)chr$(14)chr$(8)
  159. 5010 printtab(4)" [205]ondephemeriden und [205]ondphasen [146]":print
  160. 5015 printtab(9)"64'er / [214].[210]eichard 1987":print:print
  161. 5020 return
  162. 5025 :
  163. 5050 r=r*p2:q=int(r*100+.5)/100:v$=" ":ifq<0thenv$="-"
  164. 5055 q=abs(q):a$=str$(int(q)):b$=str$(int((q-int(q))*100+.5))
  165. 5060 iflen(a$)=2thena$="00"+right$(a$,1)
  166. 5065 iflen(a$)=3thena$="0"+right$(a$,2)
  167. 5070 a$=right$(a$,3):iflen(b$)=2thenb$="0"+right$(b$,1)
  168. 5075 n$=v$+a$+"."+right$(b$,2)
  169. 5080 return
  170. 5085 :
  171. 5100 rx=rx*p2/15
  172. 5105 rh=int(rx):rm=int((rx-int(rx))*60+.5)
  173. 5110 rh$=right$(str$(100+rh),2)
  174. 5115 rm$=right$(str$(100+rm),2)
  175. 5120 rx$=rh$+"h"+rm$+"m"
  176. 5125 return
  177. 5130 :
  178. 5150 a=int(x+.5):c=a+1537
  179. 5155 d=int((c-122.1)/365.25)
  180. 5160 e=int(365.25*d)
  181. 5165 f=int((c-e)/30.6001)
  182. 5170 dx=c-e-int(30.6001*f)+(x+.5-a)
  183. 5175 d$=right$(str$(1000+int(dx)),2)
  184. 5180 mx=f-1-12*int(f/14)
  185. 5185 m$=right$(str$(1000+mx),2)
  186. 5190 yx=d-4715-int((7+mx)/10)
  187. 5195 y$=right$(str$(10000+yx),4)
  188. 5200 ho=(dx-int(dx))*24
  189. 5205 mi=(ho-int(ho))*60
  190. 5210 ho=int(ho):mi=int(mi+.5)
  191. 5215 ho$=right$(str$(1000+ho),2)
  192. 5220 mi$=right$(str$(1000+mi),2)
  193. 5225 z3$=d$+"."+m$+"."+y$+" "+ho$+"h"+mi$+"m"+" [213][212]"
  194. 5230 return
  195.