1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(* $Id: JulianDay.Mod,v 1.4 1999/09/02 13:08:31 acken Exp $ *)
MODULE JulianDay;
(*
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 JulianDay.
|
