{ julian/gregorian date conversion program }

  {**************************************************************}
  {                                                              }
  { Copyright (c) 1982, 1985      Bob Schor                      }
  {                               Rockefeller University         }
  {                               1230 York Ave                  }
  {                               New York, NY   10021           }
  {                                                              }
  { All rights reserved.  May not be copied without this notice. }
  {                                                              }
  {**************************************************************}

  { ref. -- Software Practices and Experience, v. 10, p. 409 }

  { external calls as follows:

   FUNCTION juliandate (day, month, year : integer) : real; EXTERNAL;
   PROCEDURE calendardate (julian : real;
   VAR weekday, day, month, year : integer); EXTERNAL;

   juliandate returns the number of days since 31-Dec-4714 (BCE)
   calendardate is the inverse procedure, giving date in day/month/year form

   gregorian calendar adopted 14-Sep-1752 (JD 2361222)
   preceding day was 2-Sep-1752

   1-Jan-81 is JD 2444606

   key step of algorithm is to start calendar with 1-Mar-0000

   definition of variables --
   weekday         0 .. 6; sunday .. saturday
   day             1 .. 31 (other integers also legal)
   month           1 .. 12 (0, 13, 14 also legal)
   year            1753 .. future

   }

{ pascal-2 version }

  { Version 2.10 -- previous incarnation }
  { Version 5.1 -- $nomain switch added }

{$nomain   external procedures only }

CONST
  version = 'JULIAN    Version 5.1';
  daysperweek = 7;
  dayspermonth = 30.6;
  daysperyear = 365.25;
  dayspercentury = 36524.25;
  julianyearzero = 4712;
  juliandayzero = 62;
  dayofweekzero = 3;


FUNCTION juliandate(day, month, year: integer): real;
  EXTERNAL;


PROCEDURE calendardate(julian: real;
                       VAR weekday, day, month, year: integer);
  EXTERNAL;


FUNCTION juliandate {(day, month, year : integer) : real} ;


  FUNCTION truncated(realnum: real): real;

    VAR
      high: real;


    BEGIN { truncated }
      high := trunc(realnum / 10000);
      realnum := trunc(realnum - 10000 * high);
      truncated := 10000 * high + realnum
    END;


  BEGIN { juliandate }
    IF (year > 0) AND ((0 <= month) AND (month <= 14)) THEN
      BEGIN
      month := month - 3;
      IF month < 0 THEN
        BEGIN
        month := month + 12;
        year := year - 1
        END;
      juliandate := pred(day) + round(month * dayspermonth) +
                    truncated((year MOD 100) * daysperyear) +
                    truncated((year DIV 100) * dayspercentury) +
                    truncated(julianyearzero * daysperyear + juliandayzero)
      END
    ELSE
      juliandate := 0
  END;


PROCEDURE calendardate {(julian : real; VAR weekday, day, month, year :
                        integer)} ;

  VAR
    century: integer;
    weeks: real;


  FUNCTION truncated(realnum: real): real;

    VAR
      high: real;


    BEGIN { truncated }
      high := trunc(realnum / 10000);
      realnum := trunc(realnum - 10000 * high);
      truncated := 10000 * high + realnum
    END;


  BEGIN { calendardate }
    julian := julian - truncated(julianyearzero * daysperyear +
              juliandayzero);
    weeks := truncated(julian / daysperweek);
    weekday := round(julian - weeks * daysperweek);
    weekday := (weekday + dayofweekzero) MOD daysperweek;
    century := trunc((julian + 0.75) / dayspercentury);
    julian := julian - truncated(century * dayspercentury);
    year := trunc((julian + 0.75) / daysperyear);
    julian := julian - truncated(year * daysperyear);
    year := year + 100 * century;
    month := trunc((julian + 0.5) / dayspermonth);
    day := succ(trunc(julian - round(month * dayspermonth)));
    month := month + 3;
    IF month > 12 THEN
      BEGIN
      month := month - 12;
      year := year + 1
      END
  END;