hier mein Proggi in Turo Pascal, villeicht hilfts weiter..
(***************************************************************************)
(* Name des Moduls: MOON *)
(***************************************************************************)
(* Art des Moduls: PROGRAM *)
(* Bezeichner des Moduls: MOND.PAS *)
(* Dateiname des Moduls: C:\ASTRO\ASTRONOM\MOND.PAS *)
(***************************************************************************)
(* Beschreibung: Es werden, fr ein Datum Ihrer Wahl, die Koordinaten und *)
(* Ephemeriden des Mondes berechnet. *)
(* Dabei werden 60 Terme der neuen Mondtheorie ELP-2000/82 *)
(* von Chapront benutzt. Die Genauigkeit der Ergebnisse wird *)
(* ber den Zeitraum 10" in L„nge und 4" in Breite betragen. *)
(***************************************************************************)
(* externe Units: EINGABE.PAS, FUNKTION.PAS, BASIC.PAS *)
(* externe Procedure: ReadInteger, ReadReal, Bitte_Taste, PRUEF_DATUM, *)
(* WINKEL360, WINKEL2PI, DMS_DEZ, DELTA, UHRZEIT24, *)
(* DATUM_JD, JD_DATUM, WriteHMS, WriteDMS, *)
(* NutationConst, STERNZEIT *)
(* externe Function: SGN, RAD, DEG, TAN, ASN, ACS, GANZZAHL, RW *)
(***************************************************************************)
PROGRAM MOON;
USES CRT, PRINTER, EINGABE, FUNKTION, BASIC; {eigene UNITS}
CONST
MOONTABTERMS = 60;
MOONTAB = 46;
MoonTermsLR : array[1..MOONTABTERMS,1..6] of longint =
(( 0, 0, 1, 0,6288774,-20905355), ( 2, 0,-1, 0,1274027, -3699111),
( 2, 0, 0, 0, 658314, -2955968), ( 0, 0, 2, 0, 213618, -569925),
( 0, 1, 0, 0,-185116, 48888), ( 0, 0, 0, 2,-114332, -3149),
( 2, 0,-2, 0, 58793, 246158), ( 2,-1,-1, 0, 57066, -152138),
( 2, 0, 1, 0, 53322, -170733), ( 2,-1, 0, 0, 45758, -204586),
( 0, 1,-1, 0, -40923, -129620), ( 1, 0, 0, 0, -34720, 108743),
( 0, 1, 1, 0, -30383, 104755), ( 2, 0, 0,-2, 15327, 10321),
( 0, 0, 1, 2, -12528, 0), ( 0, 0, 1,-2, 10980, 79661),
( 4, 0,-1, 0, 10675, -34782), ( 0, 0, 3, 0, 10034, -23210),
( 4, 0,-2, 0, 8548, -21636), ( 2, 1,-1, 0, -7888, 24208),
( 2, 1, 0, 0, -6766, 30824), ( 1, 0,-1, 0, -5163, -8379),
( 1, 1, 0, 0, 4987, -16675), ( 2,-1, 1, 0, 4036, -12831),
( 2, 0, 2, 0, 3994, -10445), ( 4, 0, 0, 0, 3861, -11650),
( 2, 0,-3, 0, 3665, 14403), ( 0, 1,-2, 0, -2689, -7003),
( 2, 0,-1, 2, -2602, 0), ( 2,-1,-2, 0, 2390, 10056),
( 1, 0, 1, 0, -2348, 6322), ( 2,-2, 0, 0, 2236, -9884),
( 0, 1, 2, 0, -2120, 5751), ( 0, 2, 0, 0, -2069, 0),
( 2,-2,-1, 0, 2048, -4950), ( 2, 0, 1,-2, -1773, 4130),
( 2, 0, 0, 2, -1595, 0), ( 4,-1,-1, 0, 1215, -3958),
( 0, 0, 2, 2, -1110, 0), ( 3, 0,-1, 0, -892, 3258),
( 2, 1, 1, 0, -810, 2616), ( 4,-1,-2, 0, 759, -1897),
( 0, 2,-1, 0, -713, -2117), ( 2, 2,-1, 0, -700, 2354),
( 2, 1,-2, 0, 691, 0), ( 2,-1, 0,-2, 596, 0),
( 4, 0, 1, 0, 549, -1423), ( 0, 0, 4, 0, 537, -1117),
( 4,-1, 0, 0, 520, -1571), ( 1, 0,-2, 0, -487, -1739),
( 2, 1, 0,-2, -399, 0), ( 0, 0, 2,-2, -381, -4421),
( 1, 1, 1, 0, 351, 0), ( 3, 0,-2, 0, -340, 0),
( 4, 0,-3, 0, 330, 0), ( 2,-1, 2, 0, 327, 0),
( 0, 2, 1, 0, -323, 1165), ( 1, 1,-1, 0, 299, 0),
( 2, 0, 3, 0, 294, 0), ( 2, 0,-1,-2, 0, 8752));
MoonTermsB : array[1..MOONTABTERMS,1..5] of longint =
(( 0, 0, 0, 1,5128122), ( 0, 0, 1, 1, 280602),
( 0, 0, 1,-1, 277693), ( 2, 0, 0,-1, 173237),
( 2, 0,-1, 1, 55413), ( 2, 0,-1,-1, 46271),
( 2, 0, 0, 1, 32573), ( 0, 0, 2, 1, 17198),
( 2, 0, 1,-1, 9266), ( 0, 0, 2,-1, 8822),
( 2,-1, 0,-1, 8216), ( 2, 0,-2,-1, 4324),
( 2, 0, 1, 1, 4200), ( 2, 1, 0,-1, -3359),
( 2,-1,-1, 1, 2463), ( 2,-1, 0, 1, 2211),
( 2,-1,-1,-1, 2065), ( 0, 1,-1,-1, -1870),
( 4, 0,-1,-1, 1828), ( 0, 1, 0, 1, -1794),
( 0, 0, 0, 3, -1749), ( 0, 1,-1, 1, -1565),
( 1, 0, 0, 1, -1491), ( 0, 1, 1, 1, -1475),
( 0, 1, 1,-1, -1410), ( 0, 1, 0,-1, -1344),
( 1, 0, 0,-1, -1335), ( 0, 0, 3, 1, 1107),
( 4, 0, 0,-1, 1021), ( 4, 0,-1, 1, 833),
( 0, 0, 1,-3, 777), ( 4, 0,-2, 1, 671),
( 2, 0, 0,-3, 607), ( 2, 0, 2,-1, 596),
( 2,-1, 1,-1, 491), ( 2, 0,-2, 1, -451),
( 0, 0, 3,-1, 439), ( 2, 0, 2, 1, 422),
( 2, 0,-3,-1, 421), ( 2, 1,-1, 1, -366),
( 2, 1, 0, 1, -351), ( 4, 0, 0, 1, 331),
( 2,-1, 1, 1, 315), ( 2,-2, 0,-1, 302),
( 0, 0, 1, 3, -283), ( 2, 1, 1,-1, -229),
( 1, 1, 0,-1, 223), ( 1, 1, 0, 1, 223),
( 0, 1,-2,-1, -220), ( 2, 1,-1,-1, -220),
( 1, 0, 1, 1, -185), ( 2,-1,-2,-1, 181),
( 0, 1, 2, 1, -177), ( 4, 0,-2,-1, 176),
( 4,-1,-1,-1, 166), ( 1, 0, 1,-1, -164),
( 4, 0, 1,-1, 132), ( 1, 0,-1,-1, -119),
( 4,-1, 0,-1, 115), ( 2,-2, 0, 1, 107));
MoonApsiden: ARRAY[1..MOONTABTERMS+1,1..5] OF LONGINT =
(( 2, 0, 0, -16769, 4392), ( 4, 0, 0, 4589, 684),
( 6, 0, 0, -1856, 144), ( 8, 0, 0, 883, 35),
( 2,-1, 0, -773, 426), ( 0, 1, 0, 502, 456),
(10, 0, 0, -460, 9), ( 4,-1, 0, 422, 113),
( 6,-1, 0, -256, 34), (12, 0, 0, 253, 3),
( 1, 0, 0, 237, -189), ( 8,-1, 0, 162, 11),
(14, 0, 0, -145, 0), ( 0, 0, 2, 129, 212),
( 3, 0, 0, -112, -17), (10,-1, 0, -104, 4),
(16, 0, 0, 86, 0), (12,-1, 0, 69, 0),
( 5, 0, 0, 66, -4), ( 2, 0, 2, -53, 47),
(18, 0, 0, -52, 0), (14,-1, 0, -46, 0),
( 7, 0, 0, -41, 0), ( 2, 1, 0, 40, 5),
(20, 0, 0, 32, 0), ( 1, 1, 0, -32, 36),
(16,-1, 0, 31, 0), ( 4, 1, 0, -29, 0),
( 2,-2, 0, -27, 22), ( 4,-2, 0, 24, 10),
( 6,-2, 0, -21, 4), (22, 0, 0, -21, 0),
(18,-1, 0, -21, 0), ( 6, 1, 0, 19, 0),
(11, 0, 0, -18, 0), ( 8, 1, 0, -14, 0),
( 4, 0,-2, -14, -4), ( 6, 0, 2, -14, 4),
( 3, 1, 0, 14, 7), ( 5, 1, 0, -14, 0),
(13, 0, 0, 13, 0), (20,-1, 0, 13, 0),
( 3, 2, 0, 11, 0), ( 4,-2, 2, -11, 0),
( 1, 2, 0, -10, 0), (22,-1, 0, -9, 0),
( 0, 0, 4, -8, 0), ( 6, 0,-2, 8, 0),
( 2, 1,-2, 8, 0), ( 0, 2, 0, 7, 6),
( 0,-1, 2, 7, 0), ( 2, 0, 4, 7, 0),
( 0,-2, 2, -6, 0), ( 2, 2,-2, -6, 0),
(24, 0, 0, 6, 0), ( 4, 0,-4, 5, -4),
( 9, 0, 0, 27, 0), ( 4, 0, 2, 27, 13),
( 2, 2, 0, 5, 5), ( 1,-1, 0, 4, -3),
( 2, 0,-2, 0, -34));
MoonApsidenParallaxe: ARRAY[1..MOONTAB,1..5] OF LONGINT =
(( 63224, 2, 0, 0, -9147), ( -6990, 4, 0, 0, 355),
( 2834, 2,-1, 0, 159), ( 1927, 6, 0, 0, 52),
( -1263, 1, 0, 0, -841), ( -702, 8, 0, 0, 10),
( 696, 0, 1, 0, -656), ( -690, 0, 0, 2, 697),
( -629, 4,-1, 0, 65), ( -288, 2, 0,-2, -23),
( 297,10, 0, 0, 0), ( 260, 6,-1, 0, 14),
( 201, 3, 0, 0, 0), ( -161, 2, 1, 0, 43),
( 157, 1, 1, 0, 127), ( -138,12, 0, 0, 0),
( -127, 8,-1, 0, 0), ( 0, 2, 0, 2, 31),
( 81, 2, 2, 0, 19), ( -79, 5, 0, 0, 0),
( 68,14, 0, 0, 0), ( 67,10,-1, 0, 0),
( 54, 4, 1, 0, 0), ( -38, 4,-2, 0, 0),
( -38,12,-1, 0, 0), ( 37, 7, 0, 0, 0),
( -37, 4, 0, 2, 0), ( -35,16, 0, 0, 0),
( -30, 3, 1, 0, 0), ( 29, 1,-1, 0, 0),
( -25, 6, 1, 0, 0), ( 23,14,-1, 0, 0),
( 23, 0, 2, 0, -16), ( 0, 2,-2, 0, 22),
( 22, 6,-2, 0, 0), ( -21, 2,-1,-2, 0),
( -20, 9, 0, 0, 0), ( 19,18, 0, 0, 0),
( 17, 6, 0, 2, 0), ( 14, 0,-1, 2, 0),
( -14,16,-1, 0, 0), ( 13, 4, 0,-2, 0),
( 12, 8, 1, 0, 0), ( 11,11, 0, 0, 0),
( 10, 5, 1, 0, 0), ( -10,20, 0, 0, 0));
MoonPhaseCoeffTab : array[1..25, 0..2] of real = (
(-0.40720,-0.40614,-0.62801), ( 0.17241, 0.17302, 0.17172),
( 0.01608, 0.01614, 0.00862), ( 0.01039, 0.01043, 0.00804),
( 0.00739, 0.00734, 0.00454), (-0.00514,-0.00515,-0.01183),
( 0.00208, 0.00209, 0.00204), (-0.00111,-0.00111,-0.00180),
(-0.00057,-0.00057,-0.00070), ( 0.00056, 0.00056, 0.00027),
(-0.00042, 0.00042,-0.00040), ( 0.00042, 0.00042, 0.00032),
( 0.00038, 0.00038, 0.00032), (-0.00024,-0.00024,-0.00034),
(-0.00007,-0.00007,-0.00028), ( 0.00004, 0.00004, 0.00002),
( 0.00004, 0.00004, 0.00003), ( 0.00003, 0.00003, 0.00003),
( 0.00003, 0.00003, 0.00004), (-0.00003,-0.00003,-0.00004),
( 0.00003, 0.00003, 0.00002), (-0.00002,-0.00002,-0.00005),
(-0.00002,-0.00002,-0.00002), ( 0.00002, 0.00002, 0 ),
( 0 , 0 , 0.00004));
MoonPhaseAngleTab : array[1..25,0..2] of integer =
(( 0, 1, 0), ( 1, 0, 0), ( 0, 2, 0), ( 0, 0, 2),
(-1, 1, 0), ( 1, 1, 0), ( 2, 0, 0), ( 0, 1,-2),
( 0, 1, 2), ( 1, 2, 0), ( 0, 3, 0), ( 1, 0, 2),
( 1, 0,-2), (-1, 2, 0), ( 2, 1, 0), ( 0, 2,-2),
( 3, 0, 0), ( 1, 1,-2), ( 0, 2, 2), ( 1, 1, 2),
(-1, 1, 2), (-1, 1,-2), ( 1, 3, 0), ( 0, 4, 0),
(-2, 1, 0));
{ Koeffizienten von A1-A14. Korrekturen haben die Form C3 * sin(C1 + C2*T)}
MoonPhaseExtra : array[1..14, 0..2] of real =
((299.77, 0.107408,0.000325), (251.88, 0.016321,0.000165),
(251.83,26.651886,0.000164), (349.42,36.412478,0.000126),
( 84.66,18.206239,0.000110), (141.74,53.303771,0.000062),
(207.14, 2.453732,0.000060), (154.84, 7.306860,0.000056),
( 34.52,27.261239,0.000047), (207.19, 0.121824,0.000042),
(291.34, 1.844379,0.000040), (161.72,24.198154,0.000037),
(239.56,25.513099,0.000035), (331.55, 3.592518,0.000023));
VAR inkey, drucker: CHAR; {Globale Variablen}
jahr,jahre,tage,monat,monate,tag,hh,zz,xx: INTEGER;
geo_breite,geo_laenge,jd0,t0,t,ut,mez,dt,mls,mlm,mam,mas,mlk,i,f,v,cc,
entp,enta,pp,pa,jdep,jdea,parallaxe,radius,entfernung,e,c,utt,monats,
jde1, jde2: REAL;
PROCEDURE ERLAEUTERUNG;
BEGIN
ClrScr;
Writeln('KOORDINATEN UND PHYSISCHE EPHEMERIDEN:');
Writeln('Nach Eingabe des Datums und der geographischen Koordinaten Ihres');
Writeln('Beobachtungsortes berechnet der Computer die kompletten Koordinaten');
Writeln('und physischen Ephemeriden des Mondes fr diesen Zeitraum.');
Writeln('Dazu geh”ren die scheinbaren geozentrischen ekliptikalen und „quatorialen');
Writeln('Koordinaten sowie der Positionswinkel der Achse und die Libration in');
Writeln('L„nge und Breite. Des weiteren wird die selenografische Position der');
Writeln('Sonne berechnet. Zum Abschluá werden Auf,-Durch,-und Untergang des Mondes');
Writeln('in MEZ angegeben. Bei der Sommerzeit ist eine Stunde zu addieren.');
Writeln;
Writeln('EPHEMERIDEN FšR 20 TAGE:');
Writeln('Es werden fr diesen Zeitraum die wichtigsten Koordinaten und');
Writeln('Ephemeriden des Mondes wie z.B. Rektaszension, Deklination, Ekliptikale');
Writeln('L„nge und Breite, Entfernung, Elongation, Positionswinkel, Halbmesser,');
Writeln('Breite und L„nge des Mittelpunktes der Mondscheibe(Libration) berechnet.');
Writeln;
Writeln('MONDPHASEN:');
Writeln('Nach Eingabe des gewnschten Jahres berechnet der Computer den');
Writeln('Zeitpunkt der Mondphasen in MEZ.');
Writeln('Der maximale Fehler wird zwei Minuten nicht berschreiten. In den');
Writeln('meisten F„llen ist der Fehler geringer als eine Minute.');
Writeln;
BITTE_TASTE;
END;
PROCEDURE DATUMEINGABE;
BEGIN
zz:=1;
jahr:=-1000; monat:=0; tag:=0; mez:=-1; xx:=0;
geo_breite:=99;
geo_laenge:=361;
hh:=-1;
WRITELN('Bitte geben Sie das Datum ein ...');
WRITE('Jahr (-999 bis 4999):');
WHILE (jahr < -999) OR (jahr > 4999) DO
READINTEGER(jahr,4,22,2);
WRITELN;
WRITE('Monat:');
WHILE (monat < 1) OR (monat > 12) DO
READINTEGER(monat,2,7,3);
WRITELN;
WRITE('Tag:');
WHILE (tag < 1) OR (tag > 31) OR ((cc>1582.1004) AND (cc<1582.10149)) DO
BEGIN
READINTEGER(tag,2,5,4);
cc:=jahr+monat/100+tag/10000;
END;
WRITELN;
PRUEF_DATUM(tag,monat,jahr); {Prft das Datum}
WRITE('Uhrzeit(MEZ):');
WHILE (mez < 0) or (mez > 24) DO
READREAL(mez,7,14,5);
WRITELN;
DMS_DEZ(mez);
ut:=mez-1;
DATUM_JD(jahr, monat, tag, 0, jd0); {Umwandeln des Datums}
DELTA(jahr,dt);
t0:=(jd0-2451545)/36525;
t:=t0+(ut/24+dt/86400)/36525;
mez:=RW(mez,'S');
WRITE('Geographische Breite ]-90..90[:');
WHILE (geo_breite <= -90) OR (geo_breite >= 90) DO
READREAL(geo_breite,8,32,6);
WRITELN;
WRITE('Geographische L„nge (”stl. -) -180..180:');
WHILE (geo_laenge < -180) OR (geo_laenge > 180) DO
READREAL(geo_laenge,8,41,7);
WRITELN;
Write('H”he ber dem Meeresspiegel in Metern [0..8000]:');
While (hh<0) OR (hh>8000) DO
ReadInteger(hh,4,49,8);
Writeln;
geo_breite:=RAD(geo_breite);
geo_laenge:=RAD(geo_laenge);
IF inkey <> '1' THEN BEGIN
WRITE('Intervall in Minuten?:');
WHILE (xx < 1) OR (xx > 1440) DO
READINTEGER(xx,4,23,9);
WriteLn;
drucker:=' ';
Write('Ausgabe auf dem Drucker J/N ?');
WHILE (drucker <> 'J') AND (drucker <> 'N') DO
BEGIN
GotoXY(30,10);
CLREOL;
Read(drucker);
drucker:=UPCASE(drucker);
END;
END;
END; {DATUMEINGABE}
PROCEDURE PARALLAXE_ENTFERNUNG;
VAR cd, d: REAL;
ii: INTEGER;
BEGIN
d:=0; cd:=0;
for ii:=1 to MOONTABTERMS do
begin
d:=MoonTermsLR[ii,6]*COS(i*MoonTermsLR[ii,1]+mas*MoonTermsLR[ii,2]+mam*MoonTermsLR[ii,3]+f*MoonTermsLR[ii,4]);
if ABS(MoonTermsLR[ii,2])=1 THEN d:=d*e;
if ABS(MoonTermsLR[ii,2])=2 THEN d:=d*e*e;
cd:=cd+d;
end;
entfernung:=385000.56+cd/1000;
parallaxe:=ASN(6378.14/entfernung);
radius:=ASN(0.272493*SIN(parallaxe));
END; {PARALLAXE_ENTFERNUNG}
PROCEDURE APSIDEN(VAR month:REAL);
VAR k,jde,jdep1,jdea1,t,dp,mp,fp,kk,kj: REAL;
i,j: INTEGER;
BEGIN
jdep:=0; jdea:=0;
k:=GANZZAHL((jahr+month/12-1999.97)*13.2555);
jdep1:=0; jdea1:=0;
pp:=0; pa:=0;
FOR j:=0 TO 1 DO
BEGIN
IF j=1 THEN k:=k+0.5;
t:=k/1325.55;
jde:=2451534.6698+27.55454988*k-0.0006886*t*t-0.000001098*t*t*t+0.0000000052*t*t*t*t;
dp:=171.9179+335.9106046*k-0.010025*t*t-0.00001156*t*t*t+0.000000055*t*t*t*t;
mp:=347.3477+27.1577721*k-0.0008323*t*t-0.000001*t*t*t;
fp:=316.6109+364.5287911*k-0.0125131*t*t-0.0000148*t*t*t;
dp:=RAD(dp);
mp:=RAD(mp);
fp:=RAD(fp);
FOR i:= 1 to MoonTabTerms+1 DO
BEGIN
kk:=0;
kj:=0;
IF MoonTabTerms = 5 THEN BEGIN kk:= 0.00019; kj:=-0.00011 END;
IF MoonTabTerms = 6 THEN BEGIN kk:=-0.00013; kj:=-0.00011 END;
IF MoonTabTerms = 8 THEN kk:=-0.00011;
IF j=0 THEN jdep1:=jdep1+(MoonApsiden[i,4]+kk*t)*SIN(MoonApsiden[i,1]*dp+MoonApsiden[i,2]*mp+MoonApsiden[i,3]*fp);
IF j=1 THEN jdea1:=jdea1+(MoonApsiden[i,5]+kj*t)*SIN(MoonApsiden[i,1]*dp+MoonApsiden[i,2]*mp+MoonApsiden[i,3]*fp);
END;
IF j=0 THEN jdep:=jde+jdep1/1E4;
IF j=1 THEN jdea:=jde+jdea1/1E4;
FOR i:= 1 to MoonTab DO
BEGIN
kk:=0;
IF MoonTab = 3 THEN kk:=-0.0071;
IF MoonTab = 7 THEN kk:=-0.0017;
IF MoonTAb = 9 THEN kk:= 0.0016;
IF j=0 THEN pp:=pp+(MoonApsidenParallaxe[i,1]+kk*t)*COS(MoonApsidenParallaxe[i,2]*dp+MoonApsidenParallaxe[i,3]*mp
+MoonApsidenParallaxe[i,4]*fp);
IF j=1 THEN pa:=pa+MoonApsidenParallaxe[i,5]*COS(MoonApsidenParallaxe[i,2]*dp+MoonApsidenParallaxe[i,3]*mp
+MoonApsidenParallaxe[i,4]*fp);
END;
IF j=0 THEN BEGIN pp:=3629.215+pp/1000;
entp:=6378.14/SIN(RAD(pp/3600));
END
ELSE
BEGIN
pa:=3245.251+pa/1000;
enta:=6378.14/SIN(RAD(pa/3600));
END;
END;
END;
Procedure Knoten;
Var jack, k, t, d, m, n, r, v, p, jdet: Real;
Begin
jack:=0;
k:=GANZZAHL((Jahr+monat/13-2000.05)*13.4223);
t:=k/1342.23;
While (jack < 1) DO
Begin
if jack = 0.6 then k:=k+0.5;
d:=RAD(183.6380 + 331.73735691*k + 0.0015057*t*t + 0.00000209*t*t*t - 0.00000001*t*t*t*t);
m:=RAD( 17.4006 + 26.82037250*k + 0.0000999*t*t + 0.00000006*t*t*t);
n:=RAD( 38.3776 + 355.52747322*k + 0.0123577*t*t + 0.000014628*t*t*t - 0.000000069*t*t*t*t);
r:=123.9767 - 1.44098949*k + 0.0020625*t*t + 0.00000214*t*t*t -0.000000016*t*t*t*t;
v:=RAD(299.75 + 132.85*t -0.009173*t*t);
p:=RAD(r + 272.75 - 2.3*t);
r:=RAD(r);
jdet:=2451565.1619 + 27.212220817*k + 0.0002572*t*t + 0.000000021*t*t*t - 0.000000000088*t*t*t*t;
jdet:=jdet-0.4721*SIN(n)-0.1649*SIN(2*d)-0.0868*sin(2*d-n)+0.0084*sin(2*d+n)-e*0.0083*sin(2*d-m);
jdet:=jdet-e*0.0039*sin(2*d-m-n)+0.0034*sin(2*n)-0.0031*sin(2*d-2*n)+e*0.003*sin(2*d+m);
jdet:=jdet+e*0.0028*sin(m-n)+e*0.0026*sin(m)+0.0025*sin(4*d)+0.0024*sin(d)+e*0.0022*sin(m+n);
jdet:=jdet+0.0017*sin(r)+0.0014*sin(4*d-n)+e*0.0005*sin(2*d+m-n)+e*0.0004*sin(2*d-m+n);
jdet:=jdet-e*0.0003*sin(2*d-2*m)+e*0.0003*sin(4*d-m)+0.0003*sin(v)+0.0003*sin(p);
if jack = 0 then jde1:=jdet
else jde2:=jdet;
jack:=jack+0.6;
end;
End;
{Berechnet die Koordinaten und physischen Ephemeriden des Mondes}
PROCEDURE MONDBAHN;
VAR elo: STRING[9];
lauf, laufv: INTEGER;
u,z,y,rektaszension,ekliptikschiefe,gmst,gast,last,topra,topde,dlp,dl,elw,
ekl_breite,ekl_laenge,wahre_ekl_laenge,phasenwinkel,ls,wahre_ekl,deps,
dphi,exzentrizitaet,phase,deklination,br,la,pw,lgr,l0,b0,c0,a1,a2,a3,
additionl,additionb,wls: REAL;
PROCEDURE INSTALLATION;
BEGIN
e:=1-0.002516*t-0.0000074*t*t;
mlm:=218.3164591+481267.88134236*t-0.0013268*t*t+t*t*t/538841-t*t*t*t/65194000;
WINKEL360(mlm);
mam:=134.9634114+477198.8676313*t+0.008997*t*t+t*t*t/69699-t*t*t*t/14712000;
WINKEL360(mam);
mas:=357.5291092+35999.0502909*t-0.0001536*t*t+t*t*t/24490000;
WINKEL360(mas);
f:= 93.2720993+483202.0175273*t-0.0034029*t*t-t*t*t/3526000+t*t*t*t/863310000;
WINKEL360(f);
i:= 297.8502042+445267.1115168*t-0.00163*t*t+t*t*t/545868-t*t*t*t/113065000;
WINKEL360(i);
mlk:=125.044555-1934.1361849*t+0.00207062*t*t+t*t*t/467410-t*t*t*t/60616000;
WINKEL360(mlk);
mls:=280.46645+36000.76983*t+0.0003032*t*t;
WINKEL360(mls);
a1:=119.75+ 131.849*t;
a2:= 53.09+479264.29*t;
a3:=313.45+481266.484*t;
mlk:=RAD(mlk);
mls:=RAD(mls);
mlm:=RAD(mlm);
mam:=RAD(mam);
mas:=RAD(mas);
f:=RAD(f);
i:=RAD(i);
a1:=RAD(a1);
a2:=RAD(a2);
a3:=RAD(a3);
additionl:=3958*sin(a1)+1962*sin(mlm-f)+318*sin(a2);
additionb:=-2235*sin(mlm)+382*sin(a3)+175*sin(a1-f)+175*sin(a1+f)+127*sin(mlm-mam)-115*sin(mlm+mam);
ekliptikschiefe:=23.43929111-0.013004167*t-1.639e-7*t*t+5.0361e-7*t*t*t;
NutationConst(t, dphi, deps);
wahre_ekl:=ekliptikschiefe+DEG(deps);
ekliptikschiefe:=RAD(ekliptikschiefe);
wahre_ekl:=RAD(wahre_ekl);
exzentrizitaet:=0.016708617-0.000042037*t-0.0000001236*t*t;
c:=(1.9146-0.004817*t-0.000014*t*t)*SIN(mas)+(0.019993-0.000101*t)*SIN(2*mas)+0.00029*SIN(3*mas);
v:=mas+RAD(c);
wls:=mls+RAD(c);
END; {INSTALLATION}
PROCEDURE GEOZ_EKL_KOORD;
VAR c,d: REAL;
ii: INTEGER;
BEGIN
c:=0; d:=0;
for ii:=1 to MOONTABTERMS do
begin
d:=MoonTermsLR[ii,5]*SIN(i*MoonTermsLR[ii,1]+mas*MoonTermsLR[ii,2]+mam*MoonTermsLR[ii,3]+f*MoonTermsLR[ii,4]);
if ABS(MoonTermsLR[ii,2])=1 THEN d:=d*e;
if ABS(MoonTermsLR[ii,2])=2 THEN d:=d*e*e;
c:=c+d;
end;
c:=c/1E6;
ekl_laenge:=mlm+RAD(c)+RAD(additionl/1E6);
wahre_ekl_laenge:=ekl_laenge+dphi;
WINKEL2PI(ekl_laenge);
WINKEL2PI(wahre_ekl_laenge);
d:=0;
ekl_breite:=0;
for ii:=1 to MOONTABTERMS do
begin
d:=MoonTermsB[ii,5]*SIN(i*MoonTermsB[ii,1]+mas*MoonTermsB[ii,2]+mam*MoonTermsB[ii,3]+f*MoonTermsB[ii,4]);
if ABS(MoonTermsB[ii,2])=1 THEN d:=d*e;
if ABS(MoonTermsB[ii,2])=2 THEN d:=d*e*e;
ekl_breite:=ekl_breite+d;
end;
ekl_breite:=ekl_breite/1E6+additionb/1E6;
ekl_breite:=RAD(ekl_breite);
END; {GEOZ_EKL_KOORD}
PROCEDURE ELONGATION;
VAR rs,ent,rsm,laenge: REAL;
BEGIN
elw:=ACS(COS(wls-ekl_laenge)*COS(ekl_breite));
laenge:=wls-ekl_laenge;
IF laenge < 0 THEN laenge:=laenge+2*PI;
IF laenge >= PI THEN
BEGIN
IF inkey='1' THEN elo:='”stlich'
ELSE elo:='E';
END
ELSE
BEGIN
IF inkey='1' THEN elo:='westlich'
ELSE elo:='W';
END;
rs:=149598.022*(1-exzentrizitaet*exzentrizitaet)/(1+exzentrizitaet*COS(v));
ent:=entfernung/1000;
rsm:=SQRT(rs*rs+ent*ent-2*rs*ent*COS(elw));
phasenwinkel:=ACS((ent*ent+rsm*rsm-rs*rs)/(2*ent*rsm));
phase:=0.5*(1+COS(phasenwinkel))
END; {ELONGATION}
PROCEDURE GEOZ_AEQU_KOORD;
VAR u,sinq,cosq,g,h,xx,dra: REAL;
BEGIN
deklination:=ASN(SIN(wahre_ekl)*COS(ekl_breite)*SIN(wahre_ekl_laenge)+COS(wahre_ekl)*SIN(ekl_breite));
g:=COS(ekl_breite)*COS(wahre_ekl_laenge)/COS(deklination);
h:=(COS(wahre_ekl)*COS(ekl_breite)*SIN(wahre_ekl_laenge)-SIN(wahre_ekl)*SIN(ekl_breite))/COS(deklination);
IF h > 0 THEN rektaszension:=ACS(g)
ELSE rektaszension:=2*PI-ACS(g);
STERNZEIT(jahr,monat,tag,ut,ekliptikschiefe,dphi,DEG(geo_laenge),gmst,gast,last);
u:=ARCTAN(0.99664719*tan(geo_breite));
sinq:=0.99664719*SIN(u)+hh/6378140*SIN(geo_breite);
cosq:=cos(u)+hh/6378140*cos(geo_breite);
xx:=parallaxe;
dra:=ARCTAN((-cosq*SIN(xx)*SIN(last-rektaszension))/(COS(deklination)-cosq*SIN(xx)*COS(last-rektaszension)));
topra:=rektaszension+dra;
topde:=ARCTAN(((SIN(deklination)-sinq*SIN(xx))*COS(dra))/(COS(deklination)-cosq*SIN(xx)*COS(last-rektaszension)));
END; {GEOZ_AEQU_KOORD}
{$I PHYS_EPH.INC}
PROCEDURE AUSGABE1;
VAR n: WORD;
et:Real;
BEGIN
IF (lauf=1) AND (inkey='2') THEN BEGIN
CLRSCR;
Writeln('Von: ',jahr,'.',monat,'.',tag,' ',ut:2:4,' UT im Intervall: ',xx,' Min. Geo.Br.:',
DEG(geo_breite):3:2,' Geo.La.:',DEG(geo_laenge):3:2);
WRITELN('Datum UT RA(hms) DE(ø`") LA(ø) BR(ø) P(km) PA(ø) RADIUS');
WRITELN('___________________________________________________________________________');
IF drucker ='J' THEN BEGIN
Writeln(lst,'Von: ',jahr,'.',monat,'.',tag,' ',ut:2:4,' UT im Intervall: ',xx,' Min. Geo.Br.:',
DEG(geo_breite):3:2,' Geo.La.:',DEG(geo_laenge):3:2);
WRITELN(lst,'Datum UT RA(hms) DE(ø`") LA(ø) BR(ø) P(km) PA(ø) RADIUS');
WRITELN(lst,'________________________________________________________________________');
END;
END;
IF inkey='2' THEN BEGIN
deklination:=DEG(deklination);
rektaszension:=DEG(rektaszension/15);
rektaszension:=RW(rektaszension,'H');
deklination:=RW(deklination,'S');
wahre_ekl_laenge:=DEG(wahre_ekl_laenge);
ekl_breite:=DEG(ekl_breite);
parallaxe:=DEG(parallaxe)*3600;
radius:=DEG(radius)*60;
radius:=RW(radius,'M');
IF tag<10 THEN n:=2
ELSE n:=1;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(tag,'.',monat);
IF drucker ='J' THEN BEGIN
IF n=2 THEN Write(lst,' ',tag,'.',monat);
IF n=1 THEN Write(lst,tag,'.',monat);
END;
et:=ut;
DEZ_DMS(et);
if et-int(et) > 0.5929 then et:=et-0.0030;
IF ut<10 THEN n:=8
ELSE n:=7;
IF lauf < 21 THEN GotoXY(n,lauf+4)
ELSE Write(' ');
Write(et:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=8 THEN Write(lst,' ',et:2:2,' | ');
IF n=7 THEN Write(lst,et:2:2,' | ');
END;
IF rektaszension<10 THEN n:=16
ELSE n:=15;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(rektaszension:3:5,' | ');
IF drucker ='J' THEN BEGIN
IF n=16 THEN Write(lst,' ',rektaszension:3:5,' | ');
IF n=15 THEN Write(lst,rektaszension:3:5,' | ');
END;
IF (deklination<10) AND (deklination>0) THEN n:=28;
IF (deklination>=10) OR ((deklination<0) AND (deklination>=-10)) THEN n:=27;
IF deklination<-10 THEN n:=26;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(deklination:3:4,' | ');
IF drucker ='J' THEN BEGIN
IF n=28 THEN Write(lst,' ',deklination:3:4,' | ');
IF n=27 THEN Write(lst,' ',deklination:3:4,' | ');
IF n=26 THEN Write(lst,deklination:3:4,' | ')
END;
IF wahre_ekl_laenge < 10 THEN n:=39;
IF (wahre_ekl_laenge< 100) AND (wahre_ekl_laenge>=10) THEN n:=38;
IF wahre_ekl_laenge>=100 THEN n:=37;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(wahre_ekl_laenge:4:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=39 THEN Write(lst,' ',wahre_ekl_laenge:4:2,' |');
IF n=38 THEN Write(lst,' ',wahre_ekl_laenge:4:2,' |');
IF n=37 THEN Write(lst,wahre_ekl_laenge:4:2,' |');
END;
IF ekl_breite>0 THEN n:=47
ELSE n:=46;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(ekl_breite:2:2,' | ',entfernung:6:0,' | ',parallaxe:4:0,' | ',radius:2:2);
IF drucker ='J' THEN BEGIN
IF n=47 THEN Write(lst,' ',ekl_breite:2:2,' | ',entfernung:6:0,' | ',parallaxe:4:0,' | ',radius:2:2);
IF n=46 THEN Write(lst,ekl_breite:2:2,' | ',entfernung:6:0,' | ',parallaxe:4:0,' | ',radius:2:2);
END;
IF lauf >= 20 THEN WriteLn;
IF drucker ='J' THEN WriteLn(lst);
END;
IF (lauf=1) AND (inkey='3') THEN BEGIN
CLRSCR;
Writeln('Von: ',jahr,'.',monat,'.',tag,' ',ut:2:4,' UT im Intervall: ',xx,' Min. Geo.Br.:',
DEG(geo_breite):3:2,' Geo.La.:',DEG(geo_laenge):3:2);
WRITELN('Datum UT PW(ø) L(ø) B(ø) CS(ø) BS(ø) k ELW(ø) Lgr(ø)');
WRITELN('________________________________________________________________________________');
IF drucker ='J' THEN BEGIN
Writeln(lst,'Von: ',jahr,'.',monat,'.',tag,' ',ut:2:4,' UT im Intervall: ',xx,' Min. Geo.Br.:',
DEG(geo_breite):3:2,' Geo.La.:',DEG(geo_laenge):3:2);
WRITELN(lst,'Datum UT PW(ø) L(ø) B(ø) CS(ø) BS(ø) k ELW(ø) Lgr(ø)');
WRITELN(lst,'____________________________________________________________________________');
END;
END;
IF inkey='3' THEN BEGIN
elw:=DEG(elw);
IF tag<10 THEN n:=2
ELSE n:=1;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(tag,'.',monat);
IF drucker ='J' THEN BEGIN
IF n=2 THEN Write(lst,' ',tag,'.',monat)
ELSE Write(lst,tag,'.',monat);
END;
et:=ut;
DEZ_DMS(et);
if et-int(et) > 0.5929 then et:=et-0.0030;
IF ut<10 THEN n:=8
ELSE n:=7;
IF lauf < 21 THEN GotoXY(n,lauf+4)
ELSE Write(' ');
Write(et:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=8 THEN Write(lst,' ',et:2:2,' | ')
ELSE Write(lst,et:2:2,' | ');
END;
IF pw < 10 THEN n:=17;
IF (pw< 100) AND (pw>=10) THEN n:=16;
IF pw>=100 THEN n:=15;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(pw:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=17 THEN Write(lst,' ',pw:2:2,' | ');
IF n=16 THEN Write(lst,' ',pw:2:2,' | ');
IF n=15 THEN Write(lst,pw:2:2,' | ')
END;
IF la>0 THEN n:=25
ELSE n:=24;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(la:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=25 THEN Write(lst,' ',la:2:2,' | ')
ELSE Write(lst,la:2:2,' | ');
END;
IF br>0 THEN n:=33
ELSE n:=32;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(br:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=33 THEN Write(lst,' ',br:2:2,' | ')
ELSE Write(lst,br:2:2,' | ');
END;
IF c0 < 10 THEN n:=42;
IF (c0< 100) AND (c0>=10) THEN n:=41;
IF c0>=100 THEN n:=40;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(c0:2:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=42 THEN Write(lst,' ',c0:2:2,' | ');
IF n=41 THEN Write(lst,' ',c0:2:2,' | ');
IF n=40 THEN Write(lst,c0:2:2,' | ')
END;
IF b0>0 THEN n:=50
ELSE n:=49;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(b0:2:2,' | ',phase:1:2,' | ');
IF drucker ='J' THEN BEGIN
IF n=50 THEN Write(lst,' ',b0:2:2,' | ',phase:1:2,' | ')
ELSE Write(lst,b0:2:2,' | ',phase:1:2,' | ');
END;
IF elw <100 THEN n:=65;
IF elw>=100 THEN n:=64;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(elw:2:0,' ',elo,' | ');
IF drucker ='J' THEN BEGIN
IF n=65 THEN Write(lst,' ',elw:2:0,' ',elo,' | ')
ELSE Write(lst,elw:2:0,' ',elo,' | ');
END;
IF lgr<=-10 THEN n:=72;
IF (lgr>10) OR ((lgr<0) AND (lgr>-10)) THEN n:=73;
IF (lgr>=0) AND (lgr<10) THEN n:=74;
IF lauf < 21 THEN GotoXY(n,lauf+4);
Write(lgr:2:1);
IF drucker ='J' THEN BEGIN
IF n=74 THEN Write(lst,' ',lgr:2:1);
IF n=73 THEN Write(lst,' ',lgr:2:1);
IF n=72 THEN Write(lst,lgr:2:1)
END;
IF lauf >= 20 THEN WriteLn;
IF drucker ='J' THEN WriteLn(lst);
END;
END; {AUSGABE1}
PROCEDURE AUSGABE;
BEGIN
CLRSCR;
ekl_laenge:=DEG(ekl_laenge);
wahre_ekl_laenge:=DEG(wahre_ekl_laenge);
ekl_breite:=DEG(ekl_breite);
parallaxe:=DEG(parallaxe)*3600;
elw:=DEG(elw);
phasenwinkel:=DEG(phasenwinkel);
WRITELN('Ephemeriden des Mondes am ',tag,'.',monat,'.',jahr,' um ',mez:2:4,' MEZ');
WRITE('Geographische L„nge: ', ABS (DEG(geo_laenge)):3:2);
IF geo_laenge < 0 THEN WRITE(' ”stlich')
ELSE WRITE(' westlich');
WRITE(' Breite: ',DEG(geo_breite):3:2,' H”he ber NN: ',hh:5);
WRITELN;
WRITELN('Wahre geozentrische ekliptikale Koordinaten:');
WRITELN('Ekliptikale L„nge: ',ekl_laenge:3:4,'ø',' Ekliptikale Breite: ',ekl_breite:2:4,'ø');
WRITELN('Parallaxe ("): ',parallaxe:4:1,' Erdentfernung (km): ',entfernung:6:0);
WRITE('Scheinbarer Radius: ');
WriteDMS(radius,5);
WriteLn;
WRITELN('Scheinbare Koordinaten:');
WRITELN('Ekliptikale L„nge: ',wahre_ekl_laenge:3:4,'ø');
WRITE('Rektaszension: ');
WriteHMS(rektaszension,5);
Write(' Deklination: ');
WriteDMS(deklination,4);
WriteLn;
WRITELN('Scheinbare topozentrische „quatoriale Koordinaten:');
WRITE('Rektaszension: ');
WriteHMS(topra,5);
Write(' Deklination: ');
WriteDMS(topde,4);
WriteLn;
WRITELN('Lage der Rotationsachse und des Zentralmeridians des Mondes.');
WRITELN('Positionswinkel: ',pw:3:2,'ø L„nge: ',la:2:2,'ø Breite: ',br:2:2,'ø');
WRITELN('Elongation: ',elw:3:1,'ø ',elo,' Phasenwinkel: ',phasenwinkel:3:1,'ø');
WriteLn('Beleuchtung: ',phase:1:2,' Lichtgrenze: ',lgr:3:1,'ø');
Writeln('Selenografische Koordinaten des Mondes:');
WRITELN('L„nge: ',l0:3:2,'ø Breite: ',b0:3:2,'ø ',' Co-L„nge: ',c0:3:2,'ø');
jahre:=jahr;
monate:=monat;
tage:=tag;
utt:=ut;
WRITELN('Daten fr die n„chstgelegenen Apsiden:');
JD_DATUM(jdep, jahr, monat, tag, ut);
WRITELN('Perig„um: ',jahr,':',monat,':',tag,' um ',ut:2:0,' ET',' Parallaxe("): ',pp:5:3,' Entfernung: ',entp:6:0,' km');
JD_DATUM(jdea, jahr, monat, tag, ut);
WRITELN('Apog„um : ',jahr,':',monat,':',tag,' um ',ut:2:0,' ET',' Parallaxe("): ',pa:5:3,' Entfernung: ',enta:6:0,' km');
Writeln('Daten fr die n„chstgelegenen Knotendurchg„ng:');
JD_DATUM(jde1, jahr, monat, tag, ut);
Writeln('Aufsteigender Knoten: ',jahr,':',monat,':',tag,' um ',ut:2:2,' ET');
JD_DATUM(jde2, jahr, monat, tag, ut);
Writeln('Absteigender Knoten: ',jahr,':',monat,':',tag,' um ',ut:2:2,' ET');
jahr:=jahre;
monat:=monate;
tag:=tage;
ut:=utt;
END; {AUSGABE}
{$I MOONP.INC}
BEGIN {MONDBAHN}
DATUMEINGABE;
IF inkey='1' THEN
BEGIN
INSTALLATION;
GEOZ_EKL_KOORD;
PARALLAXE_ENTFERNUNG;
ELONGATION;
GEOZ_AEQU_KOORD;
PHYS_EPHEM;
monats:=monat;
APSIDEN(monats);
Knoten;
AUSGABE;
DURCHGANG;
END
ELSE
BEGIN
IF drucker = 'J' THEN laufv:=31
ELSE laufv:=20;
FOR lauf:=1 TO laufv DO
BEGIN
INSTALLATION;
GEOZ_EKL_KOORD;
PARALLAXE_ENTFERNUNG;
ELONGATION;
GEOZ_AEQU_KOORD;
PHYS_EPHEM;
AUSGABE1;
ut:=ut+xx/60;
IF ut>=24 THEN BEGIN ut:=ut-24; tag:=tag+1 END;
PRUEF_DATUM(tag,monat,jahr);
DATUM_JD(jahr, monat, tag, 0, jd0);
t0:=(jd0-2451545)/36525;
t:=t0+(ut/24+dt/86400)/36525;
END;
END;
BITTE_TASTE
END; {MONDBAHN}
PROCEDURE MONDPHASEN; {Berechnet die Mondphasen fr ein Jahr.}
VAR sp,ze: WORD;
k: LONGINT;
a,b,jde1,jde2,x,d,e,u,s,z,v,r,t,m,n,f,h,w,z0,rho: REAL;
start: BOOLEAN;
PROCEDURE MPH_INI;
VAR i: integer;
BEGIN
CLRSCR;
u:=0;
ze:=5;
jahr:=-1000;
WRITELN('Bitte geben Sie das Jahr ein ...');
WRITE('Jahr:');
WHILE (jahr < -999) OR (jahr > 4999) DO
READINTEGER(jahr,4,6,2);
WRITELN;
drucker:=' ';
Write('Ausgabe auf dem Drucker J/N ?');
WHILE (drucker <> 'J') AND (drucker <> 'N') DO
BEGIN
GotoXY(30,3);
ClrEol;
Read(drucker);
drucker:=UPCASE(drucker);
END;
DELTA(jahr,dt);
CLRSCR;
TextColor(RED);
TextBackGround(WHITE);
GotoXY(35,1);
WRITELN(jahr);
WRITELN;
IF drucker='J' THEN BEGIN
WriteLn(lst,' ',jahr);
WriteLn(lst);
END;
TextColor(LIGHTGRAY);
TextBackGround(BLACK);
WRITELN('NEUMOMD ERSTES VIERTEL VOLLMOND LETZTES VIERTEL');
WRITELN('_____________________________________________________________________');
IF drucker ='J' THEN BEGIN
WRITELN(lst,'NEUMOMD ERSTES VIERTEL VOLLMOND LETZTES VIERTEL');
WRITELN(lst,'_____________________________________________________________________');
END;
END; {MPH_INI}
{Wandelt das Julianische Datum in das Brgerliche um.}
PROCEDURE JD_DATUM(jj: REAL; sp,ze: WORD);
VAR a,c,uhrzeit: REAL;
f,ja,mon,ta,d,e,b: LONGINT;
mo : STRING[3];
uhr: STRING[7];
tage: STRING[2];
PROCEDURE AUSWAHL_MONAT(zz: INTEGER);
BEGIN
CASE zz OF
1 : mo:='JAN';
2 : mo:='FEB';
3 : mo:='MŽR';
4 : mo:='APR';
5 : mo:='MAI';
6 : mo:='JUN';
7 : mo:='JUL';
8 : mo:='AUG';
9 : mo:='SEP';
10 : mo:='OKT';
11 : mo:='NOV';
12 : mo:='DEZ';
END {CASE}
END; {AUSWAHL_MONAT}
BEGIN {JD_DATUM}
a:=INT(jj+0.5);
IF a < 2299161 THEN c:=a+1524
ELSE
BEGIN
b:=TRUNC((a-1867216.25)/36524.25);
c:=a+b-TRUNC(b/4)+1525
END;
d:=TRUNC((c-122.1)/365.25);
e:=TRUNC(365.25*d);
f:=TRUNC((c-e)/30.6001);
ta:=TRUNC(c-e-INT(30.6001*f));
mon:=f-1-12*TRUNC(f/14);
ja:=d-4715-TRUNC((7+mon)/10);
uhrzeit:=24*FRAC(jj+0.5);
Uhrzeit24(uhrzeit);
uhrzeit:=RW(uhrzeit,'S');
STR(uhrzeit:2:4,uhr);
IF uhrzeit<10 THEN uhr:=' '+uhr;
STR(ta,tage);
IF ta<10 THEN tage:=' '+tage;
IF ja = jahr THEN
BEGIN
AUSWAHL_MONAT(mon);
GotoXY(sp,ze);
WRITE(mo,',',tage,'. ',uhr);
IF drucker='J' THEN BEGIN
IF start THEN BEGIN
IF sp=19 THEN WRITE(lst,' ');
IF sp=37 THEN WRITE(lst,' ');
IF sp=55 THEN WRITE(lst,' ');
start:=False;
END; {IF start}
WRITE(lst,mo,',',tage,'. ',uhr,' ');
IF sp=55 THEN WriteLn(lst);
END; {If drucker='J'}
END; {IF ja=jahr}
END; {JD_DATUM}
PROCEDURE MPH_BERECHNUNG;
VAR i,j,xx: Integer;
wert: Array[0..2] of REAL;
ww: real;
BEGIN
start:=True;
k:=GANZZAHL((jahr-2000)*12.3685);
a:=k;
FOR i:=0 TO 54 DO
BEGIN
f:=0;
for j:=0 to 2 do
wert[j]:=0;
t:=a/1236.85;
jde1:=2451550.09765+29.530588853*a+0.0001337*t*t-0.00000015*t*t*t+0.00000000073*t*t*t*t;
m:= 2.5534+ 29.10535669*a-0.0000218*t*t-0.00000011*t*t*t;
n:=201.5643+385.81693528*a+0.1017438*t*t+0.00001239*t*t*t-0.000000058*t*t*t*t;
b:=160.7108+390.67050274*a-0.0016341*t*t-0.00000227*t*t*t+0.000000011*t*t*t*t;
rho:=124.7746-1.5637558*a +0.0020691*t*t+0.00000215*t*t*t;
e:=1-0.002516*t-0.0000074*t*t;
m:=RAD(m); n:=RAD(n); b:=RAD(b); rho:=RAD(rho);
IF (u=0) OR (u=2) THEN
BEGIN
IF u=0 THEN xx:=0;
IF u=2 THEN xx:=1;
for j:=1 to 25 do
begin
wert[xx]:=MoonPhaseCoeffTab[j,xx]*SIN(MoonPhaseAngleTab[j,0]*m+MoonPhaseAngleTab[j,1]*n+MoonPhaseAngleTab[j,2]*b);
IF (MoonPhaseAngleTab[j,0] = 1) AND
(ABS(MoonPhaseCoeffTab[j,xx]) > 0.0002) THEN wert[xx]:=wert[xx]*e;
IF (MoonPhaseAngleTab[j,0] = 2) AND
(ABS(MoonPhaseCoeffTab[j,xx]) > 0.0002) THEN wert[xx]:=wert[xx]*e*e;
f:=f+wert[xx];
end;
END
ELSE
BEGIN
for j:=1 to 25 do
begin
wert[2]:=MoonPhaseCoeffTab[j,2]*SIN(MoonPhaseAngleTab[j,0]*m+MoonPhaseAngleTab[j,1]*n+MoonPhaseAngleTab[j,2]*b);
IF MoonPhaseAngleTab[j,0] = 1 THEN wert[2]:=wert[2]*e;
IF MoonPhaseAngleTab[j,0] = 2 THEN wert[2]:=wert[2]*e*e;
f:=f+wert[2];
end;
ww:=0.00306-0.00038*e*cos(m)+0.00026*COS(n)-0.00002*cos(n-m)+0.00002*cos(n+m)+0.00002*cos(2*b);
IF u=1 THEN f:=f+ww;
IF u=3 THEN f:=f-ww;
END;
ww:=0;
for j:=1 to 14 do
ww:=ww+MoonPhaseExtra[j,2]*SIN(RAD(MoonPhaseExtra[j,0]+MoonPhaseExtra[j,1]*a));
ww:=ww-0.00017*SIN(rho);
jde1:=jde1+f+ww+1/24-dt/86400;
IF u = 0 THEN sp:=1;
IF u = 1 THEN sp:=19;
IF u = 2 THEN sp:=37;
IF u = 3 THEN sp:=55;
JD_DATUM(jde1,sp,ze);
u:=u+1;
IF u = 4 THEN
BEGIN
u:=0; ze:=ze+1
END;
a:=a+0.25;
END {FOR}
END; {MPH_BERECHNUNG}
BEGIN {MONDPHASEN}
MPH_INI;
MPH_BERECHNUNG;
Writeln;
Writeln;
BITTE_TASTE;
END; {MONDPHASEN}
Procedure Mondapsiden;
VAR jahrn,n,zeile,flag: INTEGER;
BEGIN
CLRSCR;
zeile:=8;
flag:=0;
jahr:=-1000;
monats:=0.5;
WRITELN('Bitte geben Sie das Jahr ein ...');
WRITE('Jahr:');
WHILE (jahr < -999) OR (jahr > 4999) DO
READINTEGER(jahr,4,6,2);
WRITELN;
drucker:=' ';
Write('Ausgabe auf dem Drucker J/N ?');
WHILE (drucker <> 'J') AND (drucker <> 'N') DO
BEGIN
GotoXY(30,3);
ClrEol;
Read(drucker);
drucker:=UPCASE(drucker);
END;
DELTA(jahr,dt);
WriteLn;
WRITELN('Perig„um Apog„um');
Writeln('Datum h km Datum h km');
WRITELN('______________________________________');
IF drucker ='J' THEN BEGIN
Writeln(lst,' ',jahr);
Writeln(lst);
WRITELN(lst,'Perig„um Apog„um');
Writeln(lst,'Datum h km Datum h km');
WRITELN(lst,'______________________________________');
END;
REPEAT
Apsiden(monats);
JD_DATUM(jdep, jahrn, monat, tag, ut);
IF (monat< 10) And (tag< 10) then n:=1;
IF (monat< 10) And (tag>=10) then n:=2;
IF (monat>=10) And (tag< 10) then n:=3;
IF (monat>=10) And (tag>=10) then n:=4;
IF (zeile = 8) And (jahrn<>jahr) then flag:=1;
IF (jahrn=jahr) AND (n=1) THEN Write(' ',monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=2) THEN Write(' ',monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=3) THEN Write(monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=4) THEN Write(monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF drucker = 'J' THEN BEGIN
IF flag = 1 THEN Write(' ');
IF (jahrn=jahr) AND (n=1) THEN Write(lst,' ',monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=2) THEN Write(lst,' ',monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=3) THEN Write(lst,monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
IF (jahrn=jahr) AND (n=4) THEN Write(lst,monat,' ',tag,' ',ut:2:0,' ',entp:6:0);
END;
JD_DATUM(jdea, jahrn, monat, tag, ut);
IF (monat< 10) And (tag< 10) then n:=1;
IF (monat< 10) And (tag>=10) then n:=2;
IF (monat>=10) And (tag< 10) then n:=3;
IF (monat>=10) And (tag>=10) then n:=4;
GotoXY(22,zeile);
IF (jahrn=jahr) AND (n=1) THEN WriteLn(' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=2) THEN WriteLn(' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=3) THEN WriteLn(monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=4) THEN WriteLn(monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF drucker = 'J' THEN BEGIN
IF (jahrn=jahr) AND (n=1) THEN WriteLn(lst,' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=2) THEN WriteLn(lst,' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=3) THEN WriteLn(lst,' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
IF (jahrn=jahr) AND (n=4) THEN WriteLn(lst,' ',monat,' ',tag,' ',ut:2:0,' ',enta:6:0);
END;
monats:=monats+0.9;
INC(zeile);
flag:=0;
UNTIL (monats>13);
WriteLn;
WriteLn('Zeiten in ET');
IF drucker = 'J' THEN BEGIN
WriteLn(lst);
WriteLn(lst,'Zeiten in ET');
END;
Bitte_Taste;
END;
BEGIN {HAUPTPROGRAMM}
REPEAT
CLRSCR;
WRITELN('KOORDINATEN UND PHYSISCHE EPHEMERIDEN ....1');
WRITELN('20 EPHEMERIDEN DES MONDES ................2');
WRITELN('20 PHYSISHE EPHEMERIDEN DES MONDES .......3');
WRITELN('MONDPHASEN ...............................4');
WRITELN('MONDAPSIDEN...............................5');
WRITELN('ERLŽUTERUNGEN.............................B');
WRITELN('BEENDEN ...........................<ESC>, E');
WRITELN;
WRITELN;
WRITE('BITTE WŽHLEN SIE ...');
inkey:=UPCASE(READKEY);
ClrScr;
IF inkey = 'B' THEN ERLAEUTERUNG;
IF (inkey = '1') OR (inkey = '2') OR (inkey= '3') THEN MONDBAHN;
If inkey = '4' THEN MONDPHASEN;
If inkey = '5' THEN Mondapsiden;
UNTIL inkey IN ['E',#27]
END.