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