{ 1} UNIT Kalunit;
{ 2} {$n+,e+}
{ 3} INTERFACE { UNIT mit Kalenderroutinen (c) M. Maday, DC9ZP}
{ 4} USES CRT; { Für das Astrodstprogramm 12/97}
{ 5} TYPE str12= STRING[12];
{ 6} str80= STRING[80];
{ 7} TYPE REAL=double; { Globale Variablen}
{ 8} VAR ostertag, rosenmontag, fronleichnam,pfingsten,
{ 9} himmelfahrt, weekday, jultermin, amsat_termin,
{ 10} advent4,advent1,busstag,totensonntag,jahrtermin : str12;
{ 11} julday, tag, monat,jahr,
{ 12} lfdtag, amsatday : REAL;
{ 13} day,mo,year : REAL; { Öffentliche Routinen }
{ 14} FUNCTION schaltjahr(jahr:REAL):BYTE;
{ 15} FUNCTION Jultage(tag,monat,jahr:REAL):REAL;
{ 16} FUNCTION Tv(x:REAL;x1,y1:BYTE):str12;
{ 17} FUNCTION Wochentag (jd:REAL):str12;
{ 18} FUNCTION Amsattag_TO_dat(amsattag:REAL):str12;
{ 19} FUNCTION Jul_TO_dat(JD:REAL):str12;
{ 20} FUNCTION Jahrestag(tag,monat,jahr:REAL):REAL;
{ 21} FUNCTION Lfdtag_TO_date(lfdtag,jahr:REAL):str12;
{ 22} PROCEDURE Osterdatum(jahr : INTEGER);
{ 23} PROCEDURE wr(x,y : INTEGER;xstr:str80);
{ 24} FUNCTION Datum(t,m,j:REAL):str80;
{ 25} PROCEDURE Jahrestermine(jahr:REAL);
{ 26} IMPLEMENTATION
{ 27}
{ 28} FUNCTION tv; { Umwandlung numerischer Werte in Zeichenkette}
{ 29} CONST s=' ';
{ 30} VAR xstr,ystr,astr:str12;
{ 31} BEGIN
{ 32} IF abs(x) > 10E8 THEN BEGIN str(x:0:y1,astr);tv:=astr;EXIT;END;
{ 33} str(TRUNC(x):x1,ystr);str(FRAC(abs(x)):0:y1,xstr);
{ 34} DELETE(xstr,1,1);IF (TRUNC(x)=0) AND (FRAC(x)<0) THEN
{ 35} ystr := COPY(s,1,x1-2)+'-0';
{ 36} tv := ystr+xstr;
{ 37} END;
{ 38} { Wandelt eine REAL-Zahl in eine Zeichenkette um}
{ 39} FUNCTION Tostr(x:REAL):str80;
{ 40} VAR xstr:STRING;
{ 41} BEGIN
{ 42} STR(trunc(ABS(x)):0,xstr);
{ 43} IF LENGTH(xstr)< 2 THEN xstr:='0'+xstr;
{ 44} IF x <0 THEN xstr:='-'+xstr; tostr := xstr; END;
{ 45} { Schreibt ein Datum in der bekannten Weise }
{ 46} { Übergeben werden tag,monat,Jahr (JJJJ) als Realwert}
{ 47} FUNCTION Datum;
{ 48} BEGIN datum:= tostr(t)+'.'+tostr(m)+'.'+tostr(j); END;
{ 49} { Gibt eine Zeichenkette auf dem Bildschirm an der durch }
{ 50} { x und y definierten Stelle aus }
{ 51}
{ 52} PROCEDURE Wr;
{ 53} BEGIN GOTOXY(x,y); WRITE(xstr);END;
{ 54} { Berechnet den Julianischen Tag aus einem Kalender-Datum}
{ 55} { Gültig für Julianischen Kalender bis 4.10.1582 und für }
{ 56} { den Gregorianischen Kalender ab 15.10.1582 }
{ 57} FUNCTION Jultage;
{ 58} VAR a,b,x : REAL;
{ 59} BEGIN
{ 60} x := jahr*10000.0+monat*100+tag;
{ 61} IF monat <= 2 THEN
{ 62} BEGIN jahr := jahr - 1; monat:= monat + 12; END;
{ 63} a := INT(jahr/100);
{ 64} b := 2-a+INT(a/4); { Für Greg Kalender sonst gilt..... }
{ 65} IF x <15821004.1 THEN b:=0; { wenn Tag vor dem 4.10.1582 }
{ 66} jultage := INT(365.25*(jahr+4716))+INT(30.60001*(monat+1))+
{ 67} tag + b-1524.5;
{ 68} END;
{ 69} {Wandelt Jul-Tag wieder in Kalenderdatum um}
{ 70} FUNCTION Jul_TO_dat;
{ 71} VAR z,a,b,c,d,e,x,tag,monat,jahr :REAL;
{ 72} BEGIN
{ 73} z:= int(JD+0.5);
{ 74} x:= int((z-1867216.25)/36524.25);
{ 75} a:= z+1+x-int(x/4);
{ 76} IF z < 2299161 THEN a:=z; { Wenn vor dem 4.10.1582 dann..}
{ 77} b:= a+1524;
{ 78} c:= int((b-122.1)/365.25);
{ 79} d:= int(365.25*c);
{ 80} e:= int((b-d)/30.6001);
{ 81} tag := b-d-int(30.6001*e);
{ 82} IF e < 14 THEN monat := e-1 ELSE monat:=e-13;
{ 83} IF monat > 2 THEN jahr:= c-4716 ELSE jahr:=c-4715;
{ 84} day:=tag;mo:=monat;year:=jahr;
{ 85} jul_to_dat:=datum(tag,monat,jahr);
{ 86} END;
{ 87} {Wandelt Amsattag zurück in Kalenderdatum}
{ 88} FUNCTION Amsattag_TO_dat ;
{ 89} BEGIN
{ 90} amsattag_TO_dat:=jul_to_dat(amsattag+2443509.5);
{ 91} END;
{ 92} { Ermittelt aus einem Jul-Tag den Wochentag}
{ 93} FUNCTION Wochentag;
{ 94} CONST wtage:ARRAY[0..6] of str12=('Sonntag','Montag','Dienstag',
{ 95} 'Mittwoch','Donnerstag','Freitag','Samstag');
{ 96} BEGIN
{ 97} wochentag := wtage[ TRUNC(jd+1.5) MOD 7 ];
{ 98} END;
{ 99} FUNCTION Schaltjahr (jahr:REAL):BYTE;
{100}
{101} VAR k:BYTE;
{102} BEGIN
{103} k := 2;
{104} IF (TRUNC(jahr) MOD 400=0) or
{105} ((TRUNC(jahr) MOD 4 = 0) AND (trunc(jahr) mod 100 <> 0))
{106} then k:=1;
{107} schaltjahr := k;
{108} END;
{109} {Ermittelt aus Datum den laufenden Tag des Jahres}
{110} FUNCTION Jahrestag ;
{111} VAR K:BYTE;
{112} BEGIN
{113} k := schaltjahr(jahr);
{114} jahrestag:=int(275*monat/9)-k*trunc((monat+9)/12)+tag-30;
{115} END;
{116} {Kalenderdatum aus lfd Jahrestag}
{117} FUNCTION Lfdtag_TO_date ;
{118} VAR k:INTEGER; monat,tag:REAL;
{119} BEGIN
{120} k:=schaltjahr(jahr);
{121} monat := TRUNC((9*(k+lfdtag))/275+0.98);
{122} IF lfdtag < 32 THEN monat := 1;
{123} tag := lfdtag - TRUNC((275*monat)/9) + k*trunc((monat+9)/12)+30;
{124} day := tag;mo:=monat;year:=jahr;
{125} lfdtag_TO_date:=datum(tag,monat,jahr);
{126} END;
{127} { Berechnet das Datum des Ostersonntags im Jahr }
{128} { Das Jahr wird vierstellig =JJJJ übergeben }
{129} PROCEDURE Osterdatum ;
{130} VAR
{131} a, b, c, d, e, f, g, h, i, k, l, m,
{132} wert, monat, tag : INTEGER;
{133} julian : REAL;
{134} BEGIN
{135} IF jahr < 1583 THEN
{136} { Julianisches Ostern bis zum Jahr 1582}
{137} BEGIN
{138} a := jahr MOD 4;
{139} b := jahr MOD 7;
{140} c := jahr MOD 19;
{141} d := (19*c+15) MOD 30;
{142} e := (2*a+4*b-d+34) MOD 7;
{143} wert := d + e + 114;
{144} END
{145} ELSE
{146} { Gregorianisches Ostern ab 1583 }
{147} BEGIN
{148} a := jahr MOD 19;
{149} b := jahr DIV 100;
{150} c := jahr MOD 100;
{151} d := b DIV 4;
{152} e := b MOD 4;
{153} f := (b+8) DIV 25;
{154} g := (b-f+1) DIV 3;
{155} h := (19*a+b-d-g+15) MOD 30;
{156} i := c DIV 4;
{157} k := c MOD 4;
{158} l := (32+2*e+2*i-h-k) MOD 7;
{159} m := (a+11*h+22*l) DIV 451;
{160} wert := h+l-7*m+114;
{161} END;
{162} { Und hier der Ostertermin}
{163} monat := wert DIV 31;
{164} tag := (wert MOD 31) + 1;
{165} julian := jultage(tag,monat,jahr);{ Jul-Tag Ostersonntag }
{166} ostertag := datum(tag,monat,jahr);
{167} {Termine der von den Ostern abhängigen Feiertage }
{168} rosenmontag := jul_TO_dat(julian - 48);
{169} himmelfahrt := jul_TO_dat(julian + 39);
{170} pfingsten := jul_TO_dat(julian + 49);
{171} fronleichnam:= jul_TO_dat(julian + 60);
{172} END;
{173} {Ermittelt aus einem Jul-Tag den numerischen Wochentag }
{174} FUNCTION tageszahl(jd:REAL):longint;
{175} BEGIN tageszahl:=TRUNC(jd+1.5) MOD 7; END;
{176} { Berechnet weitere Termine Advent, Totensonntag etc. }
{177} PROCEDURE Jahrestermine;
{178} VAR zahl,x:longint;
{179} BEGIN
{180} zahl:= TRUNC(jahrestag(24,12,jahr)); { Jahreszahl 24.12. }
{181} x := tageszahl(jultage(24,12,jahr));{ Wochentag ermitteln}
{182} advent4:=lfdtag_TO_date(zahl-x,jahr); { 4. Advent }
{183} advent1:=lfdtag_TO_date(zahl-x-21,jahr); { 1.Advent }
{184} totensonntag:=lfdtag_to_date(zahl-x-28,jahr);{Totensonntag }
{185} busstag:=lfdtag_TO_date(zahl-x-28-4,jahr); { Bußtag }
{186} END;
{187} BEGIN
{188} END.