unit Jul_Date ;

(*
  From: shadow@krypton.rain.com (Leonard Erickson)
  Newsgroups: comp.software.year-2000
  Subject: Date test data
  Message-ID: <961218.002551.8K5.rnr.w165w@krypton.rain.com>
  Date: Wed, 18 Dec 1996 00:25:51 PST

  For folks writing or testing date conversions between Gregorian
  calendar and Julian Day Numbers, or just checking dates in general for
  sanity here's some test data from an old article in Programmer's
  Journal. It's extracted from a program I wrote for testing my code, so
  the format is a bit odd, but it should be clear enough.

  The dates range from the start of the Gregorian calendar in Britain and
  the colonies (Sep 14, 1752) to the point where hypothetical "extra
  rules" might start affecting things (Feb 28, 4000).

  Leonard Erickson (aka Shadow)
  shadow@krypton.rain.com <--preferred
  leonard@qiclab.scn.rain.com   <--last resort
  *)

(* Modified by JRS - Watch the half day *)

interface

procedure JDtest ;

implementation

uses DateProx ;

type
TestRec = record
  DT : string [10] {date in YYYY-MM-DD format} ;
  JD : longint {Julian Day number} ;
  DW : WkDys {day of week} ;
  end ;

const NDates = 50 ;
TestData : array [1..NDates] of TestRec = ( {These JDs start at noon of DT}
  (DT:'1752-09-14';JD:2361222;DW:thu),
  (DT:'1752-12-31';JD:2361330;DW:sun),
  (DT:'1753-01-01';JD:2361331;DW:mon),
  (DT:'1799-12-31';JD:2378496;DW:tue),
  (DT:'1800-01-01';JD:2378497;DW:wed),
  (DT:'1800-02-28';JD:2378555;DW:fri),
  (DT:'1800-03-01';JD:2378556;DW:sat),
  (DT:'1800-12-31';JD:2378861;DW:wed),
  (DT:'1801-01-01';JD:2378862;DW:thu),
  (DT:'1801-02-28';JD:2378920;DW:sat),
  (DT:'1801-03-01';JD:2378921;DW:sun),
  (DT:'1858-11-17'; JD:2400001; DW:wed),
  (DT:'1899-12-31';JD:2415020;DW:sun),
  (DT:'1900-01-01';JD:2415021;DW:mon),
  (DT:'1900-02-28';JD:2415079;DW:wed),
  (DT:'1900-03-01';JD:2415080;DW:thu),
  (DT:'1900-12-31';JD:2415385;DW:mon),
  (DT:'1901-01-01';JD:2415386;DW:tue),
  (DT:'1995-10-10'; JD:2450001; DW:tue),
  (DT:'1999-12-31';JD:2451544;DW:fri),
  (DT:'2000-01-01';JD:2451545;DW:sat),
  (DT:'2000-02-28';JD:2451603;DW:mon),
  (DT:'2000-02-29';JD:2451604;DW:tue),
  (DT:'2000-03-01';JD:2451605;DW:wed),
  (DT:'2000-12-31';JD:2451910;DW:sun),
  (DT:'2001-01-01';JD:2451911;DW:mon),
  (DT:'2099-12-31';JD:2488069;DW:thu),
  (DT:'2100-01-01';JD:2488070;DW:fri),
  (DT:'2199-12-31';JD:2524593;DW:tue),
  (DT:'2200-01-01';JD:2524594;DW:wed),
  (DT:'2200-02-28';JD:2524652;DW:fri),
  (DT:'2200-03-01';JD:2524653;DW:sat),
  (DT:'2300-12-31';JD:2561482;DW:mon),
  (DT:'2400-01-01';JD:2597642;DW:sat),
  (DT:'2400-02-28';JD:2597700;DW:mon),
  (DT:'2400-02-29';JD:2597701;DW:tue),
  (DT:'2400-03-01';JD:2597702;DW:wed),
  (DT:'2600-01-01';JD:2670691;DW:wed),
  (DT:'2600-02-28';JD:2670749;DW:fri),
  (DT:'2600-03-01';JD:2670750;DW:sat),
  (DT:'2799-12-31';JD:2743738;DW:fri),
  (DT:'2800-01-01';JD:2743739;DW:sat),
  (DT:'2800-02-28';JD:2743797;DW:mon),
  (DT:'2800-02-29';JD:2743798;DW:tue),
  (DT:'2800-03-01';JD:2743799;DW:wed),
  (DT:'3199-12-31';JD:2889835;DW:fri),
  (DT:'3200-01-01';JD:2889836;DW:sat),
  (DT:'3999-12-31';JD:3182029;DW:fri),
  (DT:'4000-01-01';JD:3182030;DW:sat),
  (DT:'4000-02-28';JD:3182088;DW:mon)
  );


procedure Wait(C : integer) ;
var T : byte ; Tkr : byte absolute $40:$6C ;
begin repeat T := Tkr ; repeat until T<>Tkr ; Dec(C) until C<=0 end {Wait} ;


procedure JDtest ;
const Opts : Options = (Cal : Gregorian ; Astr : false) ;
var Y : word ; K, M, D : byte ; J : integer ; mj, mjd : longint ; W : WkDys ;
begin Writeln('Date':15, 'MJD':9, 'Dif':6, 'Weekdays':18) ;
  for K := 1 to NDates do with TestData[K] do begin
    Val(Copy(DT,1,4), Y, J) ;
    Val(Copy(DT,6,2), M, J) ;
    Val(Copy(DT,9,2), D, J) ;
    mjd := JD-2400001 ;
    mj := YMD_to_MJD(Opts, Y, M, D) ; W := DayOfWeek(mjd) ;
    Writeln(Y:9, M:3, D:3, mjd:9, mjd-mj:6,
      WeekdayS[W]:8, WeekDays[DW]:4, W=DW:6) ;
    if (MJD<>mj) or (W<>DW) then Write(^G) ;
    Wait(5) end ;
  end {JDtest} ;


BEGIN ;
END.