1(*	$Id: JulianDay.Mod,v 1.4 1999/09/02 13:08:31 acken Exp $	*)
2MODULE oocJulianDay;
3
4(*
5    JulianDay - convert to/from day/month/year and modified Julian days.
6    Copyright (C) 1996 Michael Griebling
7
8    This module is free software; you can redistribute it and/or modify
9    it under the terms of the GNU Lesser General Public License as
10    published by the Free Software Foundation; either version 2 of the
11    License, or (at your option) any later version.
12
13    This module is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU Lesser General Public License for more details.
17
18    You should have received a copy of the GNU Lesser General Public
19    License along with this program; if not, write to the Free Software
20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
21
22*)
23
24CONST
25  daysPerYear  = 365.25D0;        (* used in Julian date calculations *)
26  daysPerMonth = 30.6001D0;
27  startMJD* = 2400000.5D0;        (* zero basis for modified Julian Day in Julian days *)
28  startTJD* = startMJD+40000.0D0; (* zero basis for truncated modified Julian Day *)
29
30VAR
31  UseGregorian-: BOOLEAN;         (* TRUE when Gregorian calendar is in use *)
32  startGregor: LONGREAL;          (* start of the Gregorian calendar in Julian days *)
33
34
35(* ------------------------------------------------------------- *)
36(* Conversion functions *)
37
38PROCEDURE DateToJD * (day, month: SHORTINT; year: INTEGER) : LONGREAL;
39(* Returns a Julian date in days for the given `day', `month',
40   and `year' at 0000 UTC.  Any date with a positive year is valid.
41   Algorithm by William H. Jefferys (with some modifications) at:
42   http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
43VAR
44  A, B, C: LONGINT; JD: LONGREAL;
45BEGIN
46  IF month<3 THEN DEC(year); INC(month, 12) END;
47  IF UseGregorian THEN A:=year DIV 100; B:=A DIV 4; C:=2-A+B
48  ELSE C:=0
49  END;
50  JD:=C+day+ENTIER(daysPerYear*(year+4716))+ENTIER(daysPerMonth*(month+1))-1524.5D0;
51  IF UseGregorian & (JD>=startGregor) THEN RETURN JD
52  ELSE RETURN JD-C
53  END
54END DateToJD;
55
56PROCEDURE DateToDays * (day, month: SHORTINT; year: INTEGER) : LONGINT;
57(* Returns a modified Julian date in days for the given `day', `month',
58   and `year' at 0000 UTC.  Any date with a positive year is valid.
59   The returned value is the number of days since 17 November 1858. *)
60BEGIN
61  RETURN ENTIER(DateToJD(day, month, year)-startMJD)
62END DateToDays;
63
64PROCEDURE DateToTJD * (day, month: SHORTINT; year: INTEGER) : LONGINT;
65(* Returns a truncated modified Julian date in days for the given `day',
66  `month', and `year' at 0000 UTC.  Any date with a positive year is
67  valid.  The returned value is the *)
68BEGIN
69  RETURN ENTIER(DateToJD(day, month, year)-startTJD)
70END DateToTJD;
71
72PROCEDURE JDToDate * (jd: LONGREAL; VAR day, month: SHORTINT; VAR year: INTEGER);
73(* Converts a Julian date in days to a date given by the `day', `month', and
74   `year'.  Algorithm by William H. Jefferys (with some modifications) at
75   http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
76VAR
77  W, D, B: LONGINT;
78BEGIN
79  jd:=jd+0.5;
80  IF UseGregorian & (jd>=startGregor) THEN
81    W:=ENTIER((jd-1867216.25D0)/36524.25D0);
82    B:=ENTIER(jd+1525+W-ENTIER(W/4.0D0))
83  ELSE B:=ENTIER(jd+1524)
84  END;
85  year:=SHORT(ENTIER((B-122.1D0)/daysPerYear));
86  D:=ENTIER(daysPerYear*year);
87  month:=SHORT(SHORT(ENTIER((B-D)/daysPerMonth)));
88  day:=SHORT(SHORT(B-D-ENTIER(daysPerMonth*month)));
89  IF month>13 THEN DEC(month, 13) ELSE DEC(month) END;
90  IF month<3 THEN DEC(year, 4715) ELSE DEC(year, 4716) END
91END JDToDate;
92
93PROCEDURE DaysToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
94(* Converts a modified Julian date in days to a date given by the `day',
95   `month', and `year'. *)
96BEGIN
97  JDToDate(jd+startMJD, day, month, year)
98END DaysToDate;
99
100PROCEDURE TJDToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
101(* Converts a truncated modified Julian date in days to a date given by the `day',
102   `month', and `year'. *)
103BEGIN
104  JDToDate(jd+startTJD, day, month, year)
105END TJDToDate;
106
107PROCEDURE SetGregorianStart * (day, month: SHORTINT; year: INTEGER);
108(* Sets the start date when the Gregorian calendar was first used
109   where the date in `d' is in the Julian calendar.  The default
110   date used is 3 Sep 1752 (when the calendar correction occurred
111   according to the Julian calendar).
112
113   The Gregorian calendar was introduced in 4 Oct 1582 by Pope
114   Gregory XIII but was not adopted by many Protestant countries
115   until 2 Sep 1752.  In all cases, to make up for an inaccuracy
116   in the calendar, 10 days were skipped during adoption of the
117   new calendar. *)
118VAR
119  gFlag: BOOLEAN;
120BEGIN
121  gFlag:=UseGregorian; UseGregorian:=FALSE;  (* use Julian calendar *)
122  startGregor:=DateToJD(day, month, year);
123  UseGregorian:=gFlag                        (* back to default *)
124END SetGregorianStart;
125
126BEGIN
127  (* by default we use the Gregorian calendar *)
128  UseGregorian:=TRUE; startGregor:=0;
129
130  (* Gregorian calendar default start date *)
131  SetGregorianStart(3, 9, 1752)
132END oocJulianDay.
133