From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-JUN-1989 18:57
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: Day of week and Zeller's congruence algorithm.

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 27 JUN 89 13:15:15 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 27 Jun 89 12:21:11 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA05470; Tue, 27 Jun 89 12:00:35 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 19 Jun 89 12:27:52 GMT
From: murtoa.cs.mu.oz.au!murdu!u3369429@uunet.uu.net  (Michael Bednarek)
Organization: I.A.E.S.R., Melbourne University
Subject: Re: Day of week and Zeller's congruence algorithm.
Message-Id: <1651@murdu.oz>
References: <8906121849.AA14295@ucbvax.Berkeley.EDU>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


In article <8906121849.AA14295@ucbvax.Berkeley.EDU>, PERAINO@GMUVAX.BITNET writes:
>      A while back, someone posted the old Fortran implementation of
> Zeller's congruence algorithm for calculating the day of week. I have tried
> this function, and it doesn't work. It works for today, but I tried some
> dates in 1988 (to test leap-years) and it gave incorrect results.
>      Can anyone give me the real low-down on ZCA? If not actual code, then
> an explanation of how it works, or both? I'm not implementing on VMS, so
> I can't use lexicals. Thanx 10^6

I don't know anything about ZCA, but I wrote two subroutines to handle
date calculations. A by-product is the Day of the Week.

"In calendar and financial calculations: don't trust Real Numbers,
 use Integers!"
$!...................... Cut on the dotted line and save ......................
$! VAX/VMS archive file created by VMS_SHAR V-5.04 04-Feb-1988
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by U3369429 (Michael Bednarek)
$! on Thursday 15-JUN-1989 22:13:54.31
$!
$! It contains the following 3 files:
$! JULGREG.FOR LEAP.FOR MYMOD.FOR
$!=============================================================================
$Set Symbol/Scope=(NoLocal,NoGlobal)
$Version=F$GetSYI("VERSION")
$If Version.ges."V4.4" then goto Version_OK
$Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$Exit 44
$Version_OK:CR[0,8]=13
$Pass_or_Failed="failed!,passed."
$Goto Start
$Convert_File:
$Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1:Define/User_Mode SYS$Output NL:
$Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$Delete VMS_SHAR_DUMMY.DUMMY;*
$Checksum 'File_is
$Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2:Return
$Start:
$File_is="JULGREG.FOR"
$Check_Sum_is=812059635
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Subroutine JULGREG`009! This is a dummy subroutine name
X
X! Subroutines/Functions required:
X! LEAP`009A logical*1 function returning TRUE for a leap year, else FALSE
X! MYMOD A modified MOD(n,m) function which returns m where MOD would return 0
X
X`009Implicit Integer (A-Z)
X`009Integer*4 M1(12),M2(12)
X`009Logical*1 Leap
X`009Data`009M1/31,28,31,30, 31, 30, 31, 31, 30, 31, 30, 31/,
X`0092`009M2/ 0,31,59,90,120,151,181,212,243,273,304,334/
X
X`009Return
V!-----------------------------------------------------------------------------
X--
X`009ENTRY JULIAN (Year,Month,Day, YJDay,AJDay,WDay)
X
X! Converts Gregorian Date into Julian Day
X
X! Input: (all parameters are Integer*4)
X! Year  = Year as yyyy
X! Month = Month as mm
X! Day   = Day as dd
X
X! Output:
X! YJDay = Julian Day in this year
X! AJDay = Julian Day since 1-Jan-0001 A.D. (can be used as input to GREGOR)
X! WDay  = Day of the week, 1=Monday, 7=Sunday
X
X
X! BEWARE: Though the formula will return a "correct" value (correct within its
X!`009  design limits which does not include the Calendar Reform in 1582 which
X!`009  skipped ten days from 5-Oct to 14-Oct), its usage before this date is
X!`009  highly discouraged.
X!`009  The upper boundary for the year 5,879,490 is only to avoid integer
X!`009  overflow in the computaion of AJDay. The highest possible value the
X!`009  routine could process is 31-Dec-5,879,490 (or AJDay=2,147,439,626).
X!`009  If the expression:
X!`009  AJDay=L*365+L/4-L/100+L/400+YJDay
X!`009  would be rearranged, e.g. into:
X!`009  AJDay=L*365-L/100+L/4+L/400+YJDay
X!`009  the limit could possibly be stretched further. But who cares?
X!`009  Also, the routine doesn't work for years before 1.
X
X! NOTE:   Wolfgang Ernst at Melbourne University IAESR developed a set of
X!`009  similar routines which caters for all calendar anomalities:
X!`009  1) Calendar Reform (see above)
X!`009  2) There is no year zero
X!`009  3) All centuries before the calendar reform were leap years
X!`009  4) It works down to the date 1-Jan-4713 B.C.
X
XCheck input parameters
X`009If (Year)`00929,29, 1
X1`009If (Year-5879490)2, 2,29
X2`009If (Month)`00929,29, 3
X3`009If (Month-12)`009 4, 4,29
X4`009If (Day)`00929,29, 6
X! detect leap year
X6`009If (Leap(Year)) then
X`009  L=1
X`009else
X`009  L=0
X`009End If
X`009M1(2)=28+L
X`009If (M1(Month)-Day)`00929, 9, 9
X
XCalculate this year's Julian Day
X9`009YJDay=M2(Month)+Day
X`009If (Month.GT.2)`009`009YJDay=YJDay+L
X
XCaculate the Absolute Julian Day
X`009L=Year-1
X`009AJDay=L*365+L/4-L/100+L/400+YJDay
X`009WDay=MyMOD(AJDay,7)
X
X19`009Return
X
X! erroneous input
X29`009YJDay=-1
X`009AJDay=-1
X`009WDay=-1
X`009Go to 19
V!-----------------------------------------------------------------------------
X--
X`009ENTRY GREGOR (AJDay, Year,Month,Day)
X
X! Converts Julian Day into Gregorian Date
X
X! Input: (all parameters are Integer*4)
X! AJDay = Julian Day since 1-Jan-0001 A.D. (as obtained from JULIAN)
X
X! Output:
X! Year  = Year as yyyy
X! Month = Month as mm
X! Day   = Day as dd
X
XCheck input parameter
X`009If (AJDay)`009`009129,129,101
X101`009If (AJDay-2147439626)`009102,102,129
X102`009i=AJDay
X
X`009im=i/146097
X`009Year=im*400
X`009i=i-im*146097
X
X`009im=i/36524
X`009Year=Year+im*100
X`009i=i-im*36524
X
X`009im=i/1461
X`009Year=Year+im*4
X`009i=i-im*1461
X
X`009im=(i+364)/365-1
X`009Year=Year+im
X`009
X`009YJDay=AJDay-Year*365-Year/4+Year/100-Year/400
X`009Year=Year+1
X`009If (Leap(Year) .and. YJDay.gt.59) then
X`009  M1(2)=29
X`009else
X`009  M1(2)=28
X`009End If
X`009n1=0
X`009Do 105 Month=1,12
X`009n2=n1
X`009n1=n1+M1(Month)
X`009If (YJDay.le.n1) go to 107
X105`009Continue
X`009Month=12
X107`009Day=YJDay-n2
X
X119`009Return
X
X! erroneous input
X129`009Year=-1
X`009Month=-1
X`009Day=-1
X`009Go to 119
X
X`009End
$GoSub Convert_File
$File_is="LEAP.FOR"
$Check_Sum_is=341462515
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Logical*1 Function LEAP (Year)
X
X`009Integer   Year
X
X! Statement function to return TRUE if year is leap year
X`009Leap=MOD(Year,400).eq.0 .or.
X`0091    MOD(Year,100).ne.0 .and. MOD(Year,4).eq.0
X`009Return
X`009End
$GoSub Convert_File
$File_is="MYMOD.FOR"
$Check_Sum_is=1931040040
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Integer Function MyMOD (N,J)
X! Similar to MOD(N,J) but where MOD(N,J) returns 0, MyMOD(N,J) returns J
X`009If (J.eq.0) then
X`009  MyMOD=0
X`009else
X`009  MyMOD=N-(((N+J-1)/J-1)*J)
X`009End If
X`009Return
X`009End
$GoSub Convert_File
$Exit

--
       Michael Bednarek, Big River Ski Lodge Caravan Park, Seelands via
   //  Grafton NSW 2460, Australia,   Phone: +61 66 {44 9324 | 44 9200}
 \X/   u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au}   |  mb@munnari.oz.au
       "POST NO BILLS."                       PSI%23343000301::U3369429

