Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!samsung!munnari.oz.au!uniwa!vax6!crobw
From: Wright_RJ@cc.curtin.edu.au (Robert Wright)
Newsgroups: comp.databases
Subject: Re: Calendar Algorithm
Message-ID: <3091.26c69b52@cc.curtin.edu.au>
Date: 13 Aug 90 04:21:38 GMT
Organization: Curtin University of Technology
Lines: 146

Excuse the ancient, shouted, UPPERCASE Fortran, but this still works to the
best of my knowledge. This is really a very flexible algorithm.

(cut after this signature block...)
 /-------------------------\ /-----------------------------------------------\
| Rob Wright                |psi%050529452300070:Wright_RJ                    |
| Curtin University         |Wright_RJ@cc.curtin.edu.au                       |
| Perth, Western Australia  |Wright_RJ@cc.cut.oz.au                           |
| Voice:+61 9 351 7385      |Wright_RJ%cc.curtin.edu.au@cunyvm.bitnet         |
| FAX:     09-351-2673      |uunet!munnari.oz!cc.curtin.edu.au!Wright_RJ      |
 \-------------------------/ \-----------------------------------------------/


	SUBROUTINE JULIAN(D1,M1,Y1,D2,M2,Y2,F,J2,W2,T2)
	IMPLICIT INTEGER*4 (A-Z)
	REAL FD1,FM1,FY1,FD2,FM2,FY2,FF,FJ2,FW2,FT2
C
C	ALGORITHM DERIVED FROM HART: SOFTWARE - PRACTICE AND EXPERIENCE
C				       VOL 10, 405-417 (1980)
C	WHERE A MOST COMPLETE SYNTHESIS IS GIVEN.
C	
C	CONVERTED FROM HART'S BASIC TO FORTRAN BY R.J.WRIGHT
C	(WAIT COMPUTING CENTRE, SEPTEMBER 1980)
C
C	LANGUAGE-CONVERSION PROBLEM:
C		BASIC STORES ALL NUMBERS IN FLOATING POINT AND
C		TRULY TRUNCATES WHEN CONVERTING TO INTEGER.
C		FORTRAN IN MANY IMPLEMENTATIONS ROUNDS WHEN
C		DOING THIS CONVERSION. THUS THIS ROUTINE FIRSTLY
C		CONVERTS ALL ARGUMENTS TO FLOATING POINT, WORKS
C		IN FLOATING POINT, AND DELIBERATELY TRUNCATES
C		USING THE AINT FUNCTION. THIS IS NOT QUITE AS EFFICIENT
C		AS MAY BE DESIRED, BUT IT WORKS!
C
C	THE OTHER SIGNIFICANT CHANGE MADE WAS TO RE-ORDER THE M-D-Y
C	DATE CONVENTION TO THE MORE INTERNATIONALLY ACCEPTIBLE D-M-Y.
C
C	***** THE FOLLOWING COMMENTS ARE REPRODUCED ALMOST VERBATIM FROM HART *****
C
C	Julian conversion and inverse -- takes into account
C	leap years and the omission of February 29 in years evenly
C	divisible by 100 but not by 400 (the Gregorian convention).
C
C	J2, the Julian date, is the exact number of days since
C	BC 4714 December 31. Noon on 1981 January 1 marks the
C	beginning of JD 2444606.
C
C	D-M-Y, the Gregorian calendar, was adapted in the United
C	States on 1752 September 14 (JD 2361222). Prior to this
C	date the algorithm has no real meaning although it will
C	calculate imaginary dates back to AD 0 March 1.
C
C	In the United States daylight saving time begins at 2:00 AM
C	the last Sunday of April and extends to 2:00 AM the last
C	Sunday of October. (These are respectively the first Sunday
C	beginning day 55, and the first Sunday beginning day 239).
C	This algorithm provides T2=0 during standard time and T2=1
C	during daylight saving time.
C	Today's T2 minus yesterday's T2 is the daily adjustment to
C	the clock at 2:00 AM.
C	
C	Input arguments:
C			D1	day	usually 0..31, can also be any integer
C			M1	month	0,1..12,13,14
C			Y1	year	1753..future, must be 4 digits 
C					(xx means 19xx)
C
C	Output arguments:
C			D2	day	1..31
C			M2	month	1..12
C			Y2	year	1753..future
C			F	flag	1=Jan,Feb; 0=Mar..Dec
C			J2	JD	2361222..future; 2444606=1-1-1981
C				NOTE: J2 IS RETURNED AS 0 FOR INVALID DATE.
C			W2	weekday	0..6; Sunday..Saturday; (J2+1) MOD 7
C			T2	time	0=standard; 1=daylight saving time
C			2:00 AM adjustment = today's T2 minus yesterday's T2
C
C
C	SOME POSSIBLE USES:
C		LAST MONTH
C			first day = JULIAN(1,M-1,Y,.......)
C			last day = JULIAN(0,M,Y,...)
C
C		THIS MONTH
C			first day = JULIAN(1,M,Y,...)
C			last day = JULIAN(0,M+1,Y,...)
C
C		NEXT MONTH
C			first day = JULIAN(1,M+1,Y,...)
C			last day = JULIAN(0,M+2,Y,...)
C
C		X OR -X DAYS FROM D-M-Y
C			JULIAN(D+X,M,Y,...)
C
C		DATE FOR THE XTH DAY OF THE YEAR
C			JULIAN(X,1,Y,...)
C
C		DAYS BETWEEN TWO DATES
C			JULIAN(D1,M1,Y1,...,J1,...)
C			JULIAN(D2,M2,Y2,...,J2,...)
C			then take J2-J1
C
C		DAY OF THE YEAR
C			JULIAN(M,D,Y,...,J1,...)
C			JULIAN(0,1,Y,...,J2,...)
C			then take J2-J1
C
C
C		COPY AND FLOAT THE INPUT INTEGER ARGUMENTS
	FD1=D1
	FM1=M1
	FY1=Y1
C
	FJ2=1.				! 1=no error
	IF(FY1.LT.0. .OR. FM1.LT.-1. .OR. FM1.GT.14.) FJ2=0.	! 0=error
	IF(FJ2.NE.1.)GOTO 1000
C
	FY2=FY1			! year
	IF(FY2.LE.99.)FY2=FY2+1900.	!assume 20th century
	FF=AINT((14.-FM1)/12.)		! 1=Jan,Feb; 0=Mar...Dec
	FJ2=AINT(30.61*(FM1+1.+FF*12.))+FD1+AINT(365.25*(FY2-FF))
	FJ2=FJ2-AINT((((FY2-FF)/100.)+1.)*.75)+1720997.	! Julian day
	FW2=AINT(FJ2+1.-AINT((FJ2+1.)/7.)*7.)		! weekday: 0...6; Sun...Sat
	FY2=FJ2-1721119.1+AINT(.75*AINT((FJ2-1684594.75)/36524.25))
	FD2=AINT(FY2-AINT(365.25*AINT(FY2/365.25))+122.2)	! 123...488
	FY2=AINT(FY2/365.25)+AINT(FD2/429.)			!year
	FM2=AINT(FD2/30.61)-1.-AINT(FD2/429.)*12.		!month
	FD2=FD2-AINT(30.61*AINT(FD2/30.61))			!day
	FT2=INT(30.61*(FM2+1.+FF*12.))+FD2-FW2+1000.
	FT2=AINT(FT2/1177.)-AINT(FT2/1361.)			! 0=standard;1=daylight
	IF(FJ2.LT.2361222.)FJ2=0		!error if date < 14-Sep-1752
C	FIX THE WORKING VALUES BACK TO INTEGERS AND RETURN
C
1000	D1=FD1
	M1=FM1
	Y1=FY1
	D2=FD2
	M2=FM2
	Y2=FY2
	F=FF
	J2=FJ2
	W2=FW2
	T2=FT2
	RETURN
	END