home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / datetime.swg / 0003_DATE2.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  3.1 KB  |  82 lines
  1. {DF> I need an accurate method of converting back and Forth between
  2.   > Gregorian and Julian dates.
  3.  
  4.  if you mean the True Julian day, as used in astronomy ...
  5. }
  6.  
  7. Program JulianDate;                 { Gregorian date to Julian day  }
  8.  
  9. Uses    Crt;                        { Turbo/Quick Pascal            }
  10. Var     Month, Year, greg       : Integer;
  11.         Day, JulianDay          : Real;
  12.         LeapYear, DateOkay      : Boolean;
  13. begin
  14.     ClrScr;
  15.     WriteLn( 'Julian Dates v0.1 Dec.20.91 G.Vigneault' );
  16.     WriteLn( '[Enter Gregorian calendar values]');
  17.     WriteLn;
  18.     { A.D. years entered normally, B.C. years as negative }
  19.     Write( 'Enter Year (nnnn For A.D., -nnnn For B.C.): ' );
  20.     ReadLn( Year );
  21.     LeapYear := False;      { assume not }
  22.     if ((Year MOD 4)=0)     { possible LeapYear? }
  23.         then if ((Year MOD 100)<>0)  { LeapYear if not century }
  24.              or ((Year MOD 100)=0) and ((Year MOD 400)=0)
  25.              then LeapYear := True;
  26.     Repeat
  27.         Write( 'Enter Month (1..12): ' );
  28.         ReadLn( Month );
  29.     Until ( Month < 13 ) and ( Month > 0 );
  30.  
  31.     WriteLn('Julian Days begin at Greenwich mean noon (12:00 UT)');
  32.     DateOkay := False;
  33.     Repeat
  34.     Write( 'Enter Day (1.0 <= Day < 32.0): ' );
  35.     ReadLn( Day );          {may be decimal to include hours}
  36.     if ( Day >= 1.0 ) and ( Day < 32.0 )
  37.         then Case Month of
  38.                 1,3,5,7,8,10,12 : if Day < 32.0 then DateOkay := True;
  39.                 4,6,9,11        : if Day < 31.0 then DateOkay := True;
  40.                 2               : if ( Day < 29.0 ) or
  41.                                      ( Day < 30.0 ) and LeapYear
  42.                                   then DateOkay := True
  43.                                   else  WriteLn('not a leapyear!');
  44.                 end; {Case}
  45.         if not DateOkay then Write( #7 );       { beep }
  46.         Until DateOkay;
  47.  
  48.         (* here is where we start calculation of the Julian Date *)
  49.  
  50.         if Month in [ 1, 2 ]
  51.         then    begin
  52.                         DEC( Year );
  53.                         inC( Month, 12 )
  54.                 end;
  55.  
  56.         { account For Pope Gregory's calendar correction, when }
  57.         { the day after Oct.4.1582 was Oct.15.1582 }
  58.  
  59.         if ( Year < 1582 ) or
  60.            ( Year = 1582 ) and ( Month < 10 ) or
  61.            ( Year = 1582 ) and ( Month = 10 ) and ( Day <= 15 )
  62.         then    greg := 0       { Oct.15.1582 or earlier }
  63.         else    begin           { Oct.16.1582 or later }
  64.                         greg := TRUNC( Year div 100 );
  65.                         greg := 2 - greg + TRUNC( greg div 4 );
  66.                 end;
  67.  
  68.         if ( Year >= 0 )         { circa A.D. or B.C. ? }
  69.                 then  JulianDay := inT( 365.25 * Year )         {AD}
  70.                 else  JulianDay := inT( 365.25 * Year - 0.75 ); {BC}
  71.  
  72.         JulianDay := JulianDay
  73.                    + inT( 30.6001 * ( Month + 1 ) )
  74.                    + Day
  75.                    + 1720994.5
  76.                    + greg;
  77.  
  78.         WriteLn;
  79.         WriteLn( 'Equivalent Julian date is : ', JulianDay:8:2 );
  80.         WriteLn;
  81. end. {JulianDate}
  82.