.PSECT	DAY
	.TITLE	DAY - DETERMINE DAY OF THE WEEK
	.IDENT	/781108/
;
;    THIS CODE HAS BEEN DEVELOPED BY THE COMPUTING
;    GROUP OF THE ATMOSPHERIC SCIENCES DIVISION,
;    ALBERTA RESEARCH. THIS WORK FUNDED BY THE
;    ALBERTA WEATHER MODIFICATION BOARD.
;
;    THERE IS EXPLICITLY NO COPYRIGHT ON THIS SOFTWARE,
;    AND ITS DISTRIBUTION IS ENCOURAGED. NO RESPONSIBILITY
;    NOR GUARANTEE IS MADE OR ASSUMED BY THE AUTHOR, OR
;    BY ALBERTA RESEARCH.
;
;    SUGGESTIONS OR CHANGES ARE INVITED, AND WILL BE
;    DISTRIBUTED TO OTHER USERS OF THIS SOFTWARE THROUGH
;    THE DECUS IAS/RSX SPECIAL INTEREST GROUP.
;
;
; VERSION:	781020
; AUTHOR UNKNOWN, THIS VERSION A MODIFICATION
; DONE BY W. KORENDYK ON 24-OCT-78.
; 
; MODIFICATIONS:
;
; CODE		NAME		DATE
;

;+
;
; *** - DAY -- DETERMINE DAY OF THE WEEK FROM DATE
;
; INPUTS:	 (R5) = ONE WORD INTEGER YEAR SINCE 1900 (1977 = 77)
;		2(R5) = ONE WORD INTEGER MONTH OF YEAR
;		4(R5) = ONE WORD INTEGER DAY OF MONTH
;
; OUTPUT:	R0 = A ONE WORD INTEGER IN THE RANGE 1 - 7 SPECIFYING
;			DAY OF WEEK  (1 = SUNDAY)
;
;	ROUTINE DOES NO ERROR CHECKING.  IT ASSUMES A VALID DATE.
;	LARGEST YEAR IS APPROX. 2500  (I.E. IY <=600)
;	SMALLEST DATE IS MARCH 1, 1900
;
;
;-
	.MCALL	ENTER,LEAVE
DAY::	ENTER	R1,R2,R3,R4
	MOV	2(R5),R2	;GET MONTH
	MOV	(R5),R4		;GET YEAR
	SUB	#3,R2		;MAKE MARCH FIRST MONTH
	BGE	10$		;IF NEG THEN BELONGS TO PREVIOUS YEAR
	ADD	#12.,R2		;FIX MONTH
	DEC	R4		;AND YEAR
10$:	ASL	R2		;CALC OFFSET
	MOV	DAYS(R2),R3	;AND GET # DAYS SINCE MAR 1
	ADD	4(R5),R3	;ADD NUMBER OF DAYS INTO MONTH
	MOV	R4,R1
	CLR	R0
	DIV	#4,R0		;CALC # OF LEAP YEARS SINCE 1900
	ADD	R0,R3		;ADD TO NUMBER OF ELAPSED DAYS
	MOV	R4,R1
	CLR	R0
	DIV	#100.,R0	;CENTENNIAL YEARS NOT LEAP YEARS
	SUB	R0,R3
	MOV	R4,R1
	CLR	R0
	ADD	#300.,R1
	DIV	#400.,R0	;EVERY 4TH CENTENNIAL IS A LEAP YEAR
	ADD	R0,R3
	MOV	R4,R0
	MUL	#365.,R0	;CALC # DAYS SINCE MAR 1 1900
	ADD	R3,R1		;AND ADD TO ADJ FOR PART YEAR AND LEAPS
	ADC	R0		;DOUBLE PREC ADD
	DIV	#7,R0		;MODULO SEVEN
	MOV	R1,R0
	SUB	#3,R0		;MAKE 1 = SUNDAY
	BGT	20$
	ADD	#7,R0
20$:	LEAVE
	RTS	PC		; AND GO BACK HOME.
DAYS:	.WORD	0,31.,61.,92.,122.,153.,184.,214.,245.,275.,306.,337.
	.END