program MJD_test { Modified Julian Date : 0=1858/11/17? 50000=1995/10/10 } ; {$IFDEF ZELLER}{$IFDEF WINDOWS}Fail; no TSUNTE.TPW!{$ENDIF}{$ENDIF} {$IFDEF ZELLER} uses TSUNTE { For ZellerFn, from TSPA##70.ZIP by Timo Salmi } ; {$ENDIF} {$IFDEF WINDOWS} uses WinCrt ; {$ENDIF} function JPC(Y : integer ; const M, D : byte) : longint { Valid 1900/03/01 to 2100/02/28 inclusive ONLY } ; var L : word ; begin Y := Y-1900 ; if (M=1) or (M=2) then L := 1 else L := 0 ; JPC := 14956 + D + Trunc((Y-L)*365.25) + Trunc((M+1+L*12)*30.6001) { Last term is a linear fit of month-ends, which works } ; end { Direct Pascal translation of EN50067:1992 p.79 b) } ; function MJD(const Y : word ; const M, D : byte) : longint { Valid 1897/03/01 to 2100/02/28 inclusive ONLY ; the extension back to 1897 happens because the argument of "div" goes negative. } ; const MonthStarts : array [1..12] of word = { Jan+Feb into previous year } (15384,15415,15078,15109,15139,15170,15200,15231,15262,15292,15323,15353) ; { Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec } begin MJD := ((longint(Y)-1900-Ord(M<3))*1461) div 4 + MonthStarts[M] + D ; end { Derived from JPC by JRS; "optimised" for integers } ; var M1, M2 : longint ; Yr, Q : word ; Mo : byte ; const Dy : byte = 10 ; {$IFDEF ZELLER} var Zf : real ; const Zdiff = 678940.0 ; {$ENDIF} procedure WL ; begin Write(Yr:6, Mo:3, Dy:3, M1:9, M2:7) ; {$IFDEF ZELLER} Write(Round(Zf-Zdiff):7, Zf:12:3) ; {$ENDIF} Writeln end {WL} ; procedure Hd ; begin Write('Year':6, 'Mo':3, 'Dy':3, 'JPC':9, 'MJD':7) ; {$IFDEF ZELLER} Write('ZJD':7, 'ZellerFn':12) ; {$ENDIF} Writeln end {Hd} ; BEGIN ; Writeln('MJD_TEST.PAS (www.merlyn.demon.co.uk, >=1998/03/12);' , ^M^J' MJD, JPC should work 1900/03/01..2100/02/28.') ; { This MJD assumes every 4th year is Leap. 2000 is Leap. In actual truth, the century years are not Leap, except that every 4th century is Leap. This applies from 1752/09/14 in places then British. } Hd ; for Yr := 1897 to 2100 do for Mo := 1 to 12 do begin {$IFNDEF WINDOWS} Write(Yr, ^M) ; {$ENDIF} M1 := JPC(Yr, Mo, Dy) ; M2 := MJD(Yr, Mo, Dy) ; {$IFDEF ZELLER} Zf := ZellerFn(Dy, Mo, Yr) { in TSUNTE } ; {$ENDIF} if (M1<>M2) or (M1=50000) {$IFDEF ZELLER} or (Round(Zf-Zdiff)<>M1) {$ENDIF} then WL ; end {Yr} ; Write('') ; Readln ; Hd ; Mo := 10 ; for Q := 0 to 8 do begin Yr := 1745+50*Q ; M1 := JPC(Yr, Mo, Dy) ; M2 := MJD(Yr, Mo, Dy) ; {$IFDEF ZELLER} Zf := ZellerFn(Dy, Mo, Yr) ; {$ENDIF} WL end ; {$IFDEF ZELLER} Writeln('MJD 0 ? ', (ZellerFn(17, 11, 1858)-Zdiff):0:3) ; Writeln('Zeller 0 ?? ', (ZellerFn(2, 1, 0000)):0:3) ; Writeln('JD 2415021 ?? ', (ZellerFn(1, 1, 1900)+1721061):0:3) ; (* -1 may be error-marker *) {$ENDIF} Writeln ; Writeln('0 1 1 to end') ; repeat Write(' YYYY MM DD ??? ') ; Readln(Yr, Mo, Dy) ; M2 := MJD(Yr, Mo, Dy) ; Writeln(M2:20, M2+2400000:10) until Yr=0 ; Writeln('End. ') ; Readln ; END. MJD = JD - 2400000.5 ; Someone said : Julian days are the number of days that have elapsed since Greenwich mean noon, Jan. 1, 4713 B.C. The Julian Date for Jan. 1, 1900, at noon is 2415021.0. For Jan. 1, 1983, noon, it is 2445336.0.