home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
06
/
ldm
/
mondf.pas
< prev
Wrap
Pascal/Delphi Source File
|
1990-03-14
|
15KB
|
475 lines
(* ------------------------------------------------------ *)
(* MONDF.PAS *)
(* Berechnung von Mondfinsternissen *)
(* (c) 1990 Michael Schmelter & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM Mondfinsternis;
USES Crt;
CONST { für die Berechnung der Vollmondzeiten }
v1 = 0.0174532926;
v2 : ARRAY [1..12] OF INTEGER
= (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
{ für die Berechnung der Mondbahnkorrekturen }
lc : ARRAY [1..20] OF REAL
= ( 2.2235E-2, 1.1484E-2, -3.2463E-3, -1.9897E-3,
-1.0297E-3, 9.9484E-4, 9.2502E-4, 8.0285E-4,
7.1558E-4, -6.1087E-4, -5.236E-4 , -2.618E-4 ,
-2.2689E-4, -1.9199E-4, 1.9199E-4, 1.5708E-4,
-1.3963E-4, -1.2217E-4, 8.7266E-5, 8.7266E-5);
li : ARRAY [1..20] OF INTEGER
= (2, 2, 0, 0, -2, 2, 2, 2, 0, 1,
0, -2, 0, 0, 4, 4, 2, 2, -1, 1);
lj : ARRAY [1..20] OF INTEGER
= (0, 0, 0, 2, 0, 0, 0, 0, 0, 0,
0, 2, 2, 2, 0, 0, 0, 0, 0, 0);
lk : ARRAY [1..20] OF INTEGER
= (0, 0, 1, 0, 0, -1, 0, -1, -1, 0,
1, 0, 0, 0, 0, 0, 1, 1, 0, 1);
ll : ARRAY [1..20] OF INTEGER
= (-1, 0, 0, 0, 2, -1, 1, 0, 1, 0,
1, 0, 1, -1, -1, -2, -1, 0, 1, 0);
bc : ARRAY [1..11] OF REAL
= (8.95E-2 , 4.9044E-3, 4.852E-3 , 3.0194E-3,
9.5993E-4, 8.0285E-4, 5.7596E-4, 2.9671E-4,
1.5708E-4, 1.5708E-4, 1.3963E-4);
bi : ARRAY [1..11] OF INTEGER
= (0, 0, 0, 2, 2, 2, 2, 0, 2, 0, 2);
bj : ARRAY [1..11] OF INTEGER
= (1, 1, -1, -1, 1, -1, 1, 1, -1, -1, -1);
bk : ARRAY [1..11] OF INTEGER
= (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1);
bl : ARRAY [1..11] OF INTEGER
= (0, 1, 1, 0, -1, -1, 0, 2, 1, 2, 0);
hc : ARRAY [1..3] OF REAL
= (1.65806279E-4, 1.36135682E-4, 4.88692191E-5);
hi : ARRAY [1..3] OF INTEGER = (2, 2, 0);
hj : ARRAY [1..3] OF INTEGER = (0, 0, 0);
hk : ARRAY [1..3] OF INTEGER = (0, 0, 0);
hl : ARRAY [1..3] OF INTEGER = (-1, 0, 2);
VAR
a1 , a2 , a3 , a4 , a5 , a6 , a7 , a8 , a9 ,
a10, a11, a12, a13, a14, a15, a16, a17, a18,
a19, ln , bn , hn , w1 , w2 , w3 , w4 , w5 ,
e1 , d1 , d2 , d3 , d4 , d5 , d8 , d9 , d10,
d11, m1 , m2 , m3 , m4 , m5 , m6 , m7 , m8 ,
m9 , m10, m11, m12, m13, m14, m15, m16, m17,
m18, m19, m20, m21, m22, m23, m24, m25, m26,
m27, m28, m29, m30, er1, er2, er3, er4, v3 ,
v4 , v5 , v6 , v7 , v8 , v9 , v10, v11, v12,
v13, v14, v15, v16, v17, v18, v19, v20, v21,
v22, t : REAL;
v23, v24, v25, v26, v28 : REAL;
v27, dz, z, code : INTEGER;
vdt : ARRAY [1..12] OF REAL; { für die Vollmondzeiten }
vdm : ARRAY [1..12] OF REAL;
PROCEDURE Datum_fuer_Vollmond;
{ Julianisches Datum für die Vollmondberechnung und }
{ Abfrage auf Schalttage }
BEGIN
v6 := Trunc(v23 / 100);
v7 := 2 - v6 + Trunc(v6 / 4);
v5 := Int(365.25 * v23) +
Int(30.6001 * (v25 + 1)) + 1720996.0 + v7;
IF (v24 / 4) = 0 THEN BEGIN
IF (v24 / 100) <> 0 THEN
v2[2] := 29
ELSE
IF (v24 / 400) = 0 THEN v2[2] := 29;
END;
END;
PROCEDURE Mondlaenge;
{ Berechnung einer genäherten Mondposition }
BEGIN
v3 := 218.32 + 481267.883 * v9 +
6.29 * Sin(134.9 * v1 + 477198.85 * v1 * v9);
v3 := v3 - 1.27 * Sin(259.2 * v1 - 413335.38 * v1 * v9);
v3 := v3 + 0.66 * Sin(235.7 * v1 + 890534.23 * v1 * v9);
v3 := v3 + 0.21 * Sin(269.9 * v1 + 954397.7 * v1 * v9);
v3 := v3 - 0.19 * Sin(357.5 * v1 + 35999.05 * v1 * v9);
v3 := v3 - 0.11 * Sin(186.6 * v1 + 966404.05 * v1 * v9);
v3 := Frac(v3 / 360.0) * 360.0;
END;
PROCEDURE Sonnenlaenge;
{ Berechnung einer genäherten Sonnenposition }
BEGIN
v3 := 280.46 + 0.9856474 * v4;
v21 := v1 * (357.528 + 0.9856003 * v4);
v3 := v3 + 1.915 * Sin(v21) + 0.02 * Sin(2.0 * v21);
v3 := Frac(v3 / 360.0) * 360.0;
END;
PROCEDURE Vollmond_Daten;
{ Berechnung aller Mondphasen und Speichern der }
{ Vollmondzeiten }
BEGIN
WriteLn('Finsternisse im Jahre ', Trunc(d11), ':');
v26 := 0; v8 := 1.0; v27 := 1;
v23 := v24 - 1; v25 := 13; dz := 1;
Datum_fuer_Vollmond;
v5 := v5 - 0.5;
REPEAT
v4 := v5 - 2451545.0;
v9 := v4 / 36525.0;
Mondlaenge;
v10 := v3;
Sonnenlaenge;
v11 := v3;
v12 := v10 - v11;
IF v12 < 0 THEN v12 := v12 + 360.0;
v13 := -v12 / 12.19;
IF v12 > 20 THEN v13 := (360.0 - v12) / 12.19;
v14 := ( 90.0 - v12) / 12.19;
v15 := (180.0 - v12) / 12.19;
v16 := (270.0 - v12) / 12.19;
IF v26 = 0 THEN BEGIN
v17 := v13;
v28 := 1;
IF (v14 > 0) AND (v14 < v17) THEN BEGIN
v17 := v14;
v28 := 2;
END;
IF (v15 > 0) AND (v15 < v17) THEN BEGIN
v17 := v15;
v28 := 3;
END;
IF (v16 > 0) AND (v16 < v17) THEN BEGIN
v17 := v16;
v28 := 4;
END;
v26 := 1;
END ELSE BEGIN
IF v28 = 1 THEN v17 := v13;
IF v28 = 2 THEN v17 := v14;
IF v28 = 3 THEN v17 := v15;
IF v28 = 4 THEN v17 := v16;
End;
IF Abs(v17) < 0.01 THEN BEGIN
REPEAT
v18 := Int(v8 + 1.0 / 24.0);
v19 := v27;
IF v18 > v2[v27] THEN BEGIN
v18 := v18 - v2[v27];
v19 := v19 + 1.0;
END;
IF v18 < 1 THEN BEGIN
v18 := v2[v27 - 1];
v19 := v27 - 1;
END;
IF v28 = 1 THEN v17 := v14;
If v28 = 2 THEN v17 := v15;
If v28 = 3 THEN
IF v19 <> 0 THEN BEGIN
vdt[dz] := v18;
vdm[dz] := v19;
v17 := v16;
Inc(dz, 1);
END;
If v28 = 4 THEN v17 := v13;
v28 := v28 + 1;
IF v28 > 4 THEN v28 := 1;
IF v17 < 0 THEN v17 := v17 + 29.52;
UNTIL Abs(v17) > 0.01;
v8 := v8 + v17;
v5 := v5 + v17;
IF Int(v8) > v2[v27] THEN BEGIN
v8 := v8 - v2[v27];
v27 := v27 + 1;
END;
END ELSE BEGIN
v8 := v8 + v17;
v5 := v5 + v17;
IF Int(v8) > v2[v27] THEN BEGIN
v8 := v8 - v2[v27];
v27 := v27 + 1;
END;
END;
UNTIL v27 > 12;
END;
PROCEDURE Mond_Koordinaten;
{ Berechnung einzelner Mondbahnelemente }
BEGIN
a1 := 4.719893910 + 8399.709170 * t -
1.97745805E-5 * t * t +
3.31612559E-8 * t * t * t;
a2 := 5.16791993 + 8328.691130 * t +
1.60430665E-4 * t * t +
2.51327413E-7 * t * t * t;
a3 := 4.52354437 - 33.7571462 * t +
3.6267942E-5 * t * t +
3.83972437E-8 * t * t * t;
a4 := 1.0 - 0.002495 * t - 7.52E-6 * t * t;
a5 := 4.80052812 - 0.0401425729 * t;
a6 := 0.89360858 + 0.35255651 * t;
a7 := 6.04861308 + 2.31901899 * t -
1.60099053E - 4 * t * t;
a8 := 4.88168594 + 628.331953 * t +
5.28834765E-6 * t * t;
a9 := 6.25665633 + 628.301948 * t -
2.61799389E-6 * t * t -
5.75958655E-8 * t * t * t;
a10 := 0.01675 - 0.0000418 * t - 1.3E-7 * t * t;
a11 := 1.9999728 * a10 * Sin(a9) +
1.25000481 * a10 * a10 * Sin(2 * a9);
a11 := a11 + a10 * a10 * a10 *
(1.08332587 * Sin(3 * a9) -0.24993115 * Sin(a9));
a11 := a8 + a11;
a12 := a1 - a8;
a13 := a1 - a3;
a14 := a1 + 6.9813E-5 * Sin(a7) + 3.4907E-5 * Sin(a3);
a15 := a12 + 3.4907E-5 * Sin(a6) + 6.9813E-5 * Sin(a7) +
3.4907E-5 * Sin(a3);
a16 := a13 + 6.9813E-5 * Sin(a7) - 4.3633E-4 * Sin(a3) -
6.9813E-5 * Sin(a5 + a3);
a17 := a9 - 3.4907E-5 * Sin(a6);
a18 := a2 + 1.7453E-5 * Sin(a6) + 6.9813E-5 * Sin(a7) +
5.236E-5 * Sin(a3);
a19 := 0.10978 * Sin(a18) + 0.0036652 * Sin(2 * a18) +
1.7453E-4 * Sin(3 * a18);
END;
PROCEDURE Korrekturen;
{ Korrektur einzelner Konstanten und Mondbahnelemente }
BEGIN
lc[ 3] := lc[ 3] * a4;
lc[ 6] := lc[ 6] * a4;
lc[ 8] := lc[ 8] * a4;
lc[ 9] := lc[ 9] * a4;
lc[11] := lc[11] * a4;
lc[17] := lc[17] * a4;
lc[18] := lc[18] * a4;
lc[20] := lc[20] * a4;
bc[11] := bc[11] * a4;
a15 := Frac(a15 / (2 * pi)) * (2 * pi);
a16 := Frac(a16 / (2 * pi)) * (2 * pi);
a17 := Frac(a17 / (2 * pi)) * (2 * pi);
a18 := Frac(a18 / (2 * pi)) * (2 * pi);
ln := 0.0;
bn := 0.0;
hn := 0.0;
FOR z := 1 TO 20 DO BEGIN
ln := ln + lc[z] * Sin(li[z] * a15 + lj[z] * a16 +
lk[z] * a17 + ll[z] * a18);
IF z < 12 THEN
bn := bn + bc[z] * Sin(bi[z] * a15 + bj[z] * a16 +
bk[z] * a17 + bl[z] * a18);
IF z < 4 THEN
hn := hn + hc[z] * Cos(hi[z] * a15 + hj[z] * a16 +
hk[z] * a17 + hl[z] * a18);
END;
a14 := a14 + a19 + ln;
a14 := Frac(a14 / (2 * pi)) * (2 * pi);
d8 := bn;
END;
Procedure Winkel;
{ Berechnung von Winkeln für die Bahnebenen }
BEGIN
w1 := Cos(d8) * Cos(a14);
w2 := Cos(d8) * Sin(a14) * Cos(e1) - Sin(d8) * Sin(e1);
w3 := Cos(d8) * Sin(a14) * Sin(e1) + Sin(d8) * Cos(e1);
w4 := ArcTan(w2 / w1);
IF w1 < 0 THEN
w4 := w4 + pi
ELSE
IF w2 < 0 THEN w4 := w4 + 2 * pi;
w5 := ArcTan(w3 / Sqrt(w1 * w1 + w2 * w2));
END;
PROCEDURE Daten_Berechnung_und_Ausgabe;
BEGIN
a6 := m10 -
(m6 + m12) * Sin(m21) * Sin(m21) / (m18 + m16);
IF m23 > 0 THEN BEGIN
m25 := m19 + m4;
a7 := Sqrt(m25 * m25 - m22 * m22) *
Sin(m21) / (m18 + m16);
m26 := a6 + a7;
a7 := a6 - a7;
IF m23 > 1 THEN BEGIN
m25 := m19 - m4;
m27 := Sqrt(m25 * m25 - m22 * m22) *
Sin(m21) / (m18 + m16);
m28 := a6 + m27;
m27 := a6 - m27;
END;
END;
m25 := m20 + m4;
m29 := Sqrt(m25 * m25 - m22 * m22) *
Sin(m21) / (m18 + m16);
m30 := a6 + m29;
m29 := a6 - m29;
m6 := 360.0 * m6 / (2 * pi);
er1 := Int(m30);
er2 := 60 * (m30 - er1);
WriteLn;
IF m23 < 1 THEN
Write ('Partielle Mondfinsternis ');
IF m23 > 1 THEN BEGIN
er3 := Int(m28);
er4 := 60 * (m28 - er1);
Write ('Totale Mondfinsternis ');
END;
WriteLn ('am ', Trunc(vdt[dz]):2, '.',
Trunc(vdm[dz]):2, '.');
IF m23 > 1 THEN BEGIN
Write ('Beginn der totalen Verfinsterung ');
WriteLn ('um ', Trunc(er3):2, ':',
Trunc(er4):2, ' Uhr');
END ELSE BEGIN
Write ('Eintritt in den Halbschatten ');
WriteLn ('um ', Trunc(er1):2, ':',
Trunc(er2):2, ' Uhr');
END;
END;
PROCEDURE Datum_fuer_Mondfinsternis;
{ Julianisches Datum und Winkel für die Mondfinsternis }
BEGIN
d5 := (Int(d5) + Frac(d5) / 0.6) - d1;
IF d3 <= 2 THEN BEGIN
d3 := d3 + 12.0;
d4 := d4 - 1.0;
END;
d8 := Int(d4 / 400.0) - Int(d4 / 100.0);
d9 := Int(365.25 * d4) + Int(30.6001 * (d3 + 1)) +
d8 + 1720996.5 + d2 + d5 / 24;
t := (d9 - 2415020.0) / 36525.0;
d10 := 0.0003 + 0.00084 * t + 0.0003467 * t * t;
t := t + d10 / 36525.0;
d9 := d9 + d10;
d9 := d9 + d10;
e1 := 0.409314618 - 2.27067336E-4 * t - 2.79252681E-8;
e1 := e1 * t * t + 8.72664626E-9 * t * t * t;
END;
PROCEDURE Variablen_auf_0;
BEGIN
a1 := 0; a2 := 0; a3 := 0; a4 := 0; a5 := 0;
a6 := 0; a7 := 0; a8 := 0; a9 := 0; a10 := 0;
a11 := 0; a12 := 0; a13 := 0; a14 := 0; a15 := 0;
a16 := 0; a17 := 0; a18 := 0; a19 := 0; w1 := 0;
w2 := 0; w3 := 0; w4 := 0; w5 := 0; e1 := 0;
d5 := 0; d8 := 0; d9 := 0; d10 := 0; m2 := 0;
m3 := 0; m4 := 0; m5 := 0; m6 := 0; m7 := 0;
m8 := 0; m9 := 0; m10 := 0; m11 := 0; m12 := 0;
m13 := 0; m14 := 0; m15 := 0; m16 := 0; m17 := 0;
m18 := 0; m19 := 0; m20 := 0; m21 := 0; m22 := 0;
m23 := 0; m24 := 0; m25 := 0; m26 := 0; m27 := 0;
m28 := 0; m29 := 0; m30 := 0; t := 0;
END;
BEGIN (* Hauptprogramm *)
ClrScr;
Write ('Berechnung für das Jahr : '); ReadLn (d4);
ClrScr;
v24 := d4;
d11 := d4;
Vollmond_Daten;
dz := 1;
REPEAT
Sound (500); Delay (50); NoSound;
m1 := 0;
d1 := 1.0;
d4 := d11;
d5 := 1.0;
d2 := vdt[dz];
d3 := vdm[dz];
Datum_fuer_Mondfinsternis;
REPEAT
Mond_Koordinaten;
m2 := 0.0165945905 + 9.04080553E-4 * Cos(a18);
Korrekturen;
m3 := m2 + hn;
m4 := 0.27247 * m3;
Winkel;
m5 := w4;
m6 := w5;
a14 := a11;
d8 := 0;
Winkel;
m7 := w4 - m5;
IF m7 > 0 THEN m7 := m7 - 2 * pi;
d10 := (pi + m7) / 0.21277309;
d2 := d2 + d10;
m1 := m1 + d10;
t := ((d9 - 2415020.0) + m1) / 36525.0;
d10 := 0.0003 + 0.00084 * t + 0.0003467 * t * t;
t := t + d10 / 36525.0;
m8 := Abs(m9 / t - 1);
m9 := t;
e1 := 0.409314618 - 2.27067336E-4 * t -
2.79252681E-8;
e1 := e1 * t * t + 8.72664626E-9 * t * t * t;
UNTIL m8 < 1E-8;
d9 := d9 + m1;
m10 := 24 * Frac(d2) + d1;
m11 := w4;
m12 := w5;
m13 := 1 - a10 * Cos(a9) +
0.5 * a10 * a10 * (1 - Cos(2 * a9));
m13 := m13 -
0.375 * a10 * a10 * a10 * (Cos(3 * a9) - Cos(a9));
m14 := 4.259E-5 / m13;
m13 := 0.00466 / m13;
t := t + 1 / 438300.0;
e1 := 0.409314618 - 2.27067336E-4 * t - 2.79252681E-8;
e1 := e1 * t * t + 8.72664626E-9 * t * t * t;
Mond_Koordinaten;
Korrekturen;
Winkel;
m15 := 0.5 * (w4 - m5);
m16 := 0.5 * (w5 - m6);
a14 := a11;
d8 := 0;
Winkel;
m17 := 0.5 * (w4 - m5);
m18 := 0.5 * (w5 - m12);
m19 := 1.02 * (m3 + m14 - m13);
m20 := 1.02 * (m3 + m14 + m13);
m21 := -(m18 + m16) / (Cos(m12) * (m15 - m17));
m21 := ArcTan(m21);
m22 := Abs((m6 + m12) * Cos(m21));
m23 := (m19 - m22 + m4) / (2 * m4);
m24 := m20 - m22 + m4;
IF m24 >= 0 THEN Daten_Berechnung_und_Ausgabe;
Variablen_auf_0;
Inc(dz, 1);
UNTIL dz > 12;
WriteLn; WriteLn; WriteLn;
Write ('Bitte eine Taste drücken...');
REPEAT UNTIL KeYPressed;
ClrScr;
END.
(* ------------------------------------------------------ *)
(* Ende von MONDF.PAS *)