home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
sh2x
/
sh23a.d64
/
mondkalender
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-03-30
|
6KB
|
195 lines
100 CLR:GOSUB5000
110 :
120 P1=(null)/180:P2=180/(null):P3=(null)/648000
130 :
140 DEFFNAS(X)=ATN(X/SQR(1-X*X))
150 DEFFNAC(X)=-ATN(X/SQR(1-X*X))+(null)/2
160 DEFFNRD(X)=(X/360-INT(X/360))*360
165 DEFFNMM(X)=(X/24-INT(X/24))*24
170 :
180 INPUT" [212]AG,[205]ONAT,[202]AHR ";DA,MO,YE
190 PRINT:INPUT" [211]TD,[205]IN [[213][212]] ";HO,MI
195 GOSUB5000
200 :
210 UT=HO+MI/60:MX=MO:YX=YE
220 IFMO<=2THENMX=MO+12:YX=YE-1
230 J1=INT(365.25*YX)+INT(30.6001*(MX+1))+1720981.5+DA
240 J2=J1+UT/24
250 :
260 T1=(J2-2415020)/36525
270 T2=(J2-2451545)/36525
280 :
290 LM=FNRD(270.434164+480960*T1+307.883142*T1-.001133*T1*T1)*P1
300 MM=FNRD(296.104608+477000*T1+198.849108*T1+.009192*T1*T1)*P1
310 AK=FNRD(259.183275-1800*T1-134.142008*T1+.002078*T1*T1)*P1
320 LS=FNRD(279.696678+36000*T1+.768925*T1+.000303*T1*T1)*P1
330 MS=FNRD(358.475833+35640*T1+359.04975*T1-.00015*T1*T1)*P1
340 :
350 E(1)=22640*SIN(MM)+769*SIN(2*MM)+36*SIN(3*MM)-125*SIN(LM-LS)
360 E(2)=2370*SIN(2*(LM-LS))-668*SIN(MS)-412*SIN(2*(LM-AK))
370 E(3)=212*SIN(2*(LM-LS-MM))+4586*SIN(2*(LM-LS)-MM)+192*SIN(2*(LM-LS)+MM)
380 E(4)=165*SIN(2*(LM-LS)-MS)+206*SIN(2*(LM-LS)-MM-MS)-110*SIN(MM+MS)
390 E(5)=148*SIN(MM-MS)
400 :
410 FORI=1TO5:EL=EL+E(I):NEXTI
420 EL=LM+EL*P3
430 :
440 F(1)=18520*SIN(EL-AK+412*P3*SIN(2*(LM-AK))+541*P3*SIN(MS))
450 F(2)=-526*SIN(2*LS-LM-AK)+44*SIN(2*LS-LM-AK+MM)-31*SIN(2*LS-LM-AK-MM)
460 F(3)=-23*SIN(2*LS-LM-AK+MS)+11*SIN(2*LS-LM-AK-MS)-25*SIN(LM-AK-2*MM)
470 F(4)=21*SIN(LM-AK-MM)
480 :
490 FORI=1TO4:EB=EB+F(I):NEXTI:EB=EB*P3
500 :
510 HP=3423+187*COS(MM)+10*COS(2*MM)+34*COS(2*(LM-LS)-MM)+28*COS(2*(LM-LS))
520 HP=HP+3*COS(2*(LM-LS)+MM)
530 HP=HP*P3
540 :
550 HM=FNAS(.272493*SIN(HP))
560 :
570 DM=6378.14/SIN(HP)
580 :
600 SE=(23.439291-.013004*T2)*P1
610 DK=FNAS(SIN(SE)*COS(EB)*SIN(EL)+COS(SE)*SIN(EB))
620 RA=(COS(SE)*COS(EB)*SIN(EL)-SIN(SE)*SIN(EB))/(COS(DK)+COS(EB)*COS(EL))
630 RA=2*ATN(RA)
640 RA=RA-(RA<0)*2*(null)
650 :
660 GS=FNMM(6.656306+.0657098242*(J1-2445700.5)+1.0027379093*UT)
670 OS=FNMM(GS+7/15)
680 SZ=OS*15*P1
690 GB=49.2*P1
700 ER=6378.14
710 X=DM*COS(DK)*COS(RA)-ER*COS(GB)*COS(SZ)
720 Y=DM*COS(DK)*SIN(RA)-ER*COS(GB)*SIN(SZ)
730 Z=DM*SIN(DK)-ER*SIN(GB)
740 DT=SQR(X*X+Y*Y+Z*Z)
750 D2=FNAS((DM*SIN(DK)-ER*SIN(GB))/DT)
760 R2=DT*COS(D2)+DM*COS(DK)*COS(RA)-ER*COS(GB)*COS(SZ)
770 R2=2*ATN((DM*COS(DK)*SIN(RA)-ER*COS(GB)*SIN(SZ))/R2)
780 R2=R2-(R2<0)*2*(null)
790 :
800 SW=SZ-R2
810 H=FNAS(SIN(GB)*SIN(D2)+COS(GB)*COS(D2)*COS(SW))
820 A=2*ATN((COS(D2)*SIN(SW))/(COS(H)+SIN(GB)*COS(D2)*COS(SW)-COS(GB)*SIN(D2)))
830 AZ=A-(A<0)*2*(null)
835 :
840 Z1$=RIGHT$(STR$(100+DA),2)+"."+RIGHT$(STR$(100+MO),2)+"."
845 Z1$=Z1$+RIGHT$(STR$(10000+YE),4)
850 Z2$=RIGHT$(STR$(100+HO),2)+"H"+RIGHT$(STR$(100+MI),2)+"M"+" [213][212]"
855 :
860 PRINT" [196]ATUM :[146] ";Z1$:PRINT
865 PRINT" [213]HRZEIT:[146] ";Z2$:PRINT
867 PRINTTAB(10)" [210]EKT.[146] [196]EKL.[146] [197]NTFERNUNG[146]"
870 RX=RA:GOSUB5100:PRINT:PRINT" GEOZ. :[146] ";RX$;
875 R=DK:GOSUB5050:PRINT" ";N$;" ";
877 PRINTINT(DM+.5)" KM":PRINT
880 RX=R2:GOSUB5100:PRINT" TOPOZ.:[146] ";RX$;
885 R=D2:GOSUB5050:PRINT" ";N$;" ";
887 PRINTINT(DT+.5)" KM":PRINT
890 R=AZ:GOSUB5050:PRINT" [193]ZIMUT:[146]";N$;" ";
900 R=H:GOSUB5050:PRINT" [200]OEHE: [146]";N$;" [199]RD":PRINT
905 R=HM*120:GOSUB5050:PRINT" [205]ONDDURCHMESSER:[146]";N$;" '":PRINT
910 R=HP*120:GOSUB5050:PRINT" [197]RDDURCHMESSER :[146]";N$;" '":PRINT
915 PRINT:PRINTTAB(20)"WEITER MIT [212]ASTE[146] ";
920 POKE198,0:WAIT198,1:POKE198,0
925 :
926 PRINT"JA[146][144]"
930 T3=YE+(MO-1)/12+DA/365
935 K(1)=INT((T3-1900)*12.3685+.5)
940 K(2)=K(1)+.5
945 K(3)=K(1)+.25
950 K(4)=K(1)+.75
952 :
955 FORI=1TO4
960 T(I)=K(I)/1236.85
965 JD(I)=2415020.75933+29.53058868*K(I)+.0001178*T(I)*T(I)-.000000155*T(I)^3
970 JD(I)=JD(I)+.00033*SIN((166.56+132.87*T(I)-.009173*T(I)*T(I))*P1)
975 M(I)=FNRD(359.2242+29.10535608*K(I)-.0000333*T(I)^2-.00000347*T(I)^3)*P1
980 MM(I)=FNRD(306.0253+385.81691806*K(I)+.0107306*T(I)^2+.00001236*T(I)^3)*P1
985 F(I)=FNRD(21.2964+390.67050646*K(I)-.0016528*T(I)^2-.00000239*T(I)^3)*P1
990 NEXTI
992 :
995 FORI=1TO2
1000 A1=(.1734-.000393*T(I))*SIN(M(I))+.0021*SIN(2*M(I))-.4068*SIN(MM(I))
1005 A2=.0161*SIN(2*MM(I))-.0004*SIN(3*MM(I))+.0104*SIN(2*F(I))
1010 A3=-.0051*SIN(M(I)+MM(I))-.0074*SIN(M(I)-MM(I))+.0004*SIN(2*F(I)+M(I))
1015 A4=-.0004*SIN(2*F(I)-M(I))-.0006*SIN(2*F(I)+MM(I))+.001*SIN(2*F(I)-MM(I))
1020 A5=.0005*SIN(M(I)+2*MM(I))
1025 JD(I)=JD(I)+A1+A2+A3+A4+A5
1030 NEXTI
1032 :
1035 FORI=3TO4
1040 A1=(.1721-.0004*T(I))*SIN(M(I))+.0021*SIN(2*M(I))-.628*SIN(MM(I))
1045 A2=.0089*SIN(2*MM(I))-.0004*SIN(3*MM(I))+.0079*SIN(2*F(I))
1050 A3=-.0119*SIN(M(I)+MM(I))-.0047*SIN(M(I)-MM(I))+.0003*SIN(2*F(I)+M(I))
1055 A4=-.0004*SIN(2*F(I)-M(I))-.0006*SIN(2*F(I)+MM(I))+.0021*SIN(2*F(I)-MM(I))
1060 A5=.0003*SIN(M(I)+2*MM(I))+.0004*SIN(M(I)-2*MM(I))-.0003*SIN(2*M(I)+MM(I))
1065 JD(I)=JD(I)+A1+A2+A3+A4+A5
1070 NEXTI
1075 JD(3)=JD(3)+.0028-.0004*COS(M(3))+.0003*COS(MM(3))
1080 JD(4)=JD(4)-.0028+.0004*COS(M(4))-.0003*COS(MM(4))
1082 :
1085 ZT(1)=JD(1)
1090 ZT(2)=JD(3)
1095 ZT(3)=JD(2)
1100 ZT(4)=JD(4)
1105 GOSUB5000
1110 PRINT" [205]ONDPHASEN [146]":PRINT
1115 PRINT:X=ZT(1):GOSUB5150
1120 PRINT" [206]EUMOND :[146] ";Z3$
1125 PRINT:X=ZT(2):GOSUB5150
1130 PRINT" [197]RSTES [214]IERTEL :[146] ";Z3$
1135 PRINT:X=ZT(3):GOSUB5150
1140 PRINT" [214]OLLMOND :[146] ";Z3$
1145 PRINT:X=ZT(4):GOSUB5150
1150 PRINT" [204]ETZTES [214]IERTEL:[146] ";Z3$
1155 PRINT:PRINT
1160 PRINTTAB(5)"[197]PHEMERIDEN WIEDERHOLEN (1) [146][144]":PRINT
1165 PRINTTAB(5)"[208]ROGRAMM NEU BEGINNEN (2) [146][144]":PRINT
1167 PRINTTAB(5)"[208]ROGRAMM BEENDEN (3) [146][144]"
1170 GETW$:IFW$=""THEN1170
1175 IFW$="1"THENGOSUB5000:GOTO860
1177 IFW$="2"THEN100
1179 IFW$="3"THENEND
1180 GOTO1170
4999 END
5000 POKE53281,14:POKE53280,6:POKE646,0
5005 PRINTCHR$(147)CHR$(14)CHR$(8)
5010 PRINTTAB(4)" [205]ONDEPHEMERIDEN UND [205]ONDPHASEN [146]":PRINT
5015 PRINTTAB(9)"64'ER / [214].[210]EICHARD 1987":PRINT:PRINT
5020 RETURN
5025 :
5050 R=R*P2:Q=INT(R*100+.5)/100:V$=" ":IFQ<0THENV$="-"
5055 Q=ABS(Q):A$=STR$(INT(Q)):B$=STR$(INT((Q-INT(Q))*100+.5))
5060 IFLEN(A$)=2THENA$="00"+RIGHT$(A$,1)
5065 IFLEN(A$)=3THENA$="0"+RIGHT$(A$,2)
5070 A$=RIGHT$(A$,3):IFLEN(B$)=2THENB$="0"+RIGHT$(B$,1)
5075 N$=V$+A$+"."+RIGHT$(B$,2)
5080 RETURN
5085 :
5100 RX=RX*P2/15
5105 RH=INT(RX):RM=INT((RX-INT(RX))*60+.5)
5110 RH$=RIGHT$(STR$(100+RH),2)
5115 RM$=RIGHT$(STR$(100+RM),2)
5120 RX$=RH$+"H"+RM$+"M"
5125 RETURN
5130 :
5150 A=INT(X+.5):C=A+1537
5155 D=INT((C-122.1)/365.25)
5160 E=INT(365.25*D)
5165 F=INT((C-E)/30.6001)
5170 DX=C-E-INT(30.6001*F)+(X+.5-A)
5175 D$=RIGHT$(STR$(1000+INT(DX)),2)
5180 MX=F-1-12*INT(F/14)
5185 M$=RIGHT$(STR$(1000+MX),2)
5190 YX=D-4715-INT((7+MX)/10)
5195 Y$=RIGHT$(STR$(10000+YX),4)
5200 HO=(DX-INT(DX))*24
5205 MI=(HO-INT(HO))*60
5210 HO=INT(HO):MI=INT(MI+.5)
5215 HO$=RIGHT$(STR$(1000+HO),2)
5220 MI$=RIGHT$(STR$(1000+MI),2)
5225 Z3$=D$+"."+M$+"."+Y$+" "+HO$+"H"+MI$+"M"+" [213][212]"
5230 RETURN