mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 12:12:25 +00:00
5326e1d4bb
riders are not very useful because PosixFileDesc, Files and StdChannels are not ported.
Former-commit-id: e05e466d38
132 lines
5.1 KiB
Modula-2
132 lines
5.1 KiB
Modula-2
(* $Id: JulianDay.Mod,v 1.4 1999/09/02 13:08:31 acken Exp $ *)
|
|
MODULE oocJulianDay;
|
|
|
|
(*
|
|
JulianDay - convert to/from day/month/year and modified Julian days.
|
|
Copyright (C) 1996 Michael Griebling
|
|
|
|
This module is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU Lesser General Public License as
|
|
published by the Free Software Foundation; either version 2 of the
|
|
License, or (at your option) any later version.
|
|
|
|
This module is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU Lesser General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
*)
|
|
|
|
CONST
|
|
daysPerYear = 365.25D0; (* used in Julian date calculations *)
|
|
daysPerMonth = 30.6001D0;
|
|
startMJD* = 2400000.5D0; (* zero basis for modified Julian Day in Julian days *)
|
|
startTJD* = startMJD+40000.0D0; (* zero basis for truncated modified Julian Day *)
|
|
|
|
VAR
|
|
UseGregorian-: BOOLEAN; (* TRUE when Gregorian calendar is in use *)
|
|
startGregor: LONGREAL; (* start of the Gregorian calendar in Julian days *)
|
|
|
|
|
|
(* ------------------------------------------------------------- *)
|
|
(* Conversion functions *)
|
|
|
|
PROCEDURE DateToJD * (day, month: SHORTINT; year: INTEGER) : LONGREAL;
|
|
(* Returns a Julian date in days for the given `day', `month',
|
|
and `year' at 0000 UTC. Any date with a positive year is valid.
|
|
Algorithm by William H. Jefferys (with some modifications) at:
|
|
http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
|
|
VAR
|
|
A, B, C: LONGINT; JD: LONGREAL;
|
|
BEGIN
|
|
IF month<3 THEN DEC(year); INC(month, 12) END;
|
|
IF UseGregorian THEN A:=year DIV 100; B:=A DIV 4; C:=2-A+B
|
|
ELSE C:=0
|
|
END;
|
|
JD:=C+day+ENTIER(daysPerYear*(year+4716))+ENTIER(daysPerMonth*(month+1))-1524.5D0;
|
|
IF UseGregorian & (JD>=startGregor) THEN RETURN JD
|
|
ELSE RETURN JD-C
|
|
END
|
|
END DateToJD;
|
|
|
|
PROCEDURE DateToDays * (day, month: SHORTINT; year: INTEGER) : LONGINT;
|
|
(* Returns a modified Julian date in days for the given `day', `month',
|
|
and `year' at 0000 UTC. Any date with a positive year is valid.
|
|
The returned value is the number of days since 17 November 1858. *)
|
|
BEGIN
|
|
RETURN ENTIER(DateToJD(day, month, year)-startMJD)
|
|
END DateToDays;
|
|
|
|
PROCEDURE DateToTJD * (day, month: SHORTINT; year: INTEGER) : LONGINT;
|
|
(* Returns a truncated modified Julian date in days for the given `day',
|
|
`month', and `year' at 0000 UTC. Any date with a positive year is
|
|
valid. The returned value is the *)
|
|
BEGIN
|
|
RETURN ENTIER(DateToJD(day, month, year)-startTJD)
|
|
END DateToTJD;
|
|
|
|
PROCEDURE JDToDate * (jd: LONGREAL; VAR day, month: SHORTINT; VAR year: INTEGER);
|
|
(* Converts a Julian date in days to a date given by the `day', `month', and
|
|
`year'. Algorithm by William H. Jefferys (with some modifications) at
|
|
http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
|
|
VAR
|
|
W, D, B: LONGINT;
|
|
BEGIN
|
|
jd:=jd+0.5;
|
|
IF UseGregorian & (jd>=startGregor) THEN
|
|
W:=ENTIER((jd-1867216.25D0)/36524.25D0);
|
|
B:=ENTIER(jd+1525+W-ENTIER(W/4.0D0))
|
|
ELSE B:=ENTIER(jd+1524)
|
|
END;
|
|
year:=SHORT(ENTIER((B-122.1D0)/daysPerYear));
|
|
D:=ENTIER(daysPerYear*year);
|
|
month:=SHORT(SHORT(ENTIER((B-D)/daysPerMonth)));
|
|
day:=SHORT(SHORT(B-D-ENTIER(daysPerMonth*month)));
|
|
IF month>13 THEN DEC(month, 13) ELSE DEC(month) END;
|
|
IF month<3 THEN DEC(year, 4715) ELSE DEC(year, 4716) END
|
|
END JDToDate;
|
|
|
|
PROCEDURE DaysToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
|
|
(* Converts a modified Julian date in days to a date given by the `day',
|
|
`month', and `year'. *)
|
|
BEGIN
|
|
JDToDate(jd+startMJD, day, month, year)
|
|
END DaysToDate;
|
|
|
|
PROCEDURE TJDToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
|
|
(* Converts a truncated modified Julian date in days to a date given by the `day',
|
|
`month', and `year'. *)
|
|
BEGIN
|
|
JDToDate(jd+startTJD, day, month, year)
|
|
END TJDToDate;
|
|
|
|
PROCEDURE SetGregorianStart * (day, month: SHORTINT; year: INTEGER);
|
|
(* Sets the start date when the Gregorian calendar was first used
|
|
where the date in `d' is in the Julian calendar. The default
|
|
date used is 3 Sep 1752 (when the calendar correction occurred
|
|
according to the Julian calendar).
|
|
|
|
The Gregorian calendar was introduced in 4 Oct 1582 by Pope
|
|
Gregory XIII but was not adopted by many Protestant countries
|
|
until 2 Sep 1752. In all cases, to make up for an inaccuracy
|
|
in the calendar, 10 days were skipped during adoption of the
|
|
new calendar. *)
|
|
VAR
|
|
gFlag: BOOLEAN;
|
|
BEGIN
|
|
gFlag:=UseGregorian; UseGregorian:=FALSE; (* use Julian calendar *)
|
|
startGregor:=DateToJD(day, month, year);
|
|
UseGregorian:=gFlag (* back to default *)
|
|
END SetGregorianStart;
|
|
|
|
BEGIN
|
|
(* by default we use the Gregorian calendar *)
|
|
UseGregorian:=TRUE; startGregor:=0;
|
|
|
|
(* Gregorian calendar default start date *)
|
|
SetGregorianStart(3, 9, 1752)
|
|
END oocJulianDay.
|