[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]

    (*     JULIAN.PAS - test Julian algorithms

         test values: 1/1/79 = 2443875
                    1/1/1900 = 2415021
                      1/1/70 = 2440588
                     8/28/40 = 2429870

                                  Robert B. Wooster [72415,1602]
                                  March 1985

         Note: because of the magnitude of the numbers involved
         here this probably requires an 8x87 and hence is limited
         to MS or PC/DOS machines.  However, it may work with the
         forthcoming BCD routines.
    *)

    program JULIAN;

    var
         JNUM     : real;
         month,
         day,
         year     : integer;

    {----------------------------------------------}
    function Jul( mo, da, yr: integer): real;
    { this is an implementation of the FORTRAN one-liner:
         JD(I, J, K) = K - 32075 + 1461 * (I + 4800 + (J-14) / 12) / 4
         + 367 * (j - 2 - ((J - 14) / 12) * 12) / 12
         - 3 * (( I + 4900 + (J - 14) / 12) / 100 / 4; where I,J,K are
         year, month, and day.  The original version takes advantage of
         FORTRAN's automatic truncation of integers but requires support
         of integers somewhat larger than Turbo's Maxint, hence all of the
         Int()'s .  The variable returned is an integer day count using
         1 January 1980 as 0. }

    var     i, j, k, j2, ju: real;
    begin
         i := yr;     j := mo;     k := da;
         j2 := int( (j - 14)/12 );
         ju := k - 32075 + int(1461 * ( i + 4800 + j2 ) / 4 );
         ju := ju + int( 367 * (j - 2 - j2 * 12) / 12);
         ju := ju - int(3 * int( (i + 4900 + j2) / 100) / 4);
         Jul := ju;
    end;  { Jul }

    {----------------------------------------------}
    procedure JtoD(pj: real; var mo, da, yr: integer);
    { this reverses the calculation in Jul, returning the
         result in a Date_Rec }
    var     ju, i, j, k, l, n: real;
    begin
         ju := pj;
         l := ju + 68569.0;
         n := int( 4 * l / 146097.0);
         l := l - int( (146097.0 * n + 3)/ 4 );
         i := int( 4000.0 * (l+1)/1461001.0);
         l := l - int(1461.0*i/4.0) + 31.0;
         j := int( 80 * l/2447.0);
         k := l - int( 2447.0 * j / 80.0);
         l := int(j/11);
         j := j+2-12*l;
         i := 100*(n - 49) + i + l;
         yr := trunc(i);
         mo := trunc(j);
         da := trunc(k);
    end;  { JtoD }

    {-----------------MAIN-----------------------------}
    begin
         writeln('This program tests the Julian date algorithms.');
         writeln('Enter a calendar date in the form MM DD YYYY <return>');
         writeln('Enter a date of 00 00 00 to end the program.');

         day := 1;
         while day<>0 do begin

              writeln;
              write('Enter MM DD YY '); readln( month, day, year);
              if day<>0 then begin
                   JNUM  :=  Jul( month, day, year);
                   writeln('The Julian # of ',month,'/',day,'/',year,
                        ' is ', JNUM:10:0);
                   JtoD( JNUM, month, day, year);
                   Writeln('The date corresponding to ', JNUM:10:0, ' is ',
                             month,'/',day,'/',year);
                   end;
              end;
         writeln('That''s all folks.....');
    end.

    (* end of file JULIAN.PAS *)

[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]