C	PROGRAM DAYTIME.FT
C	---------------
C
C
C
	SUBROUTINE DAYTIME(JDEV)
C
C
C
C	PETER LEMKIN
C	NATIONAL INSTITUTES OF HEALTH
C	BETHESDA, MD. 20014
C
C
C
C	JAN 25, 1978
C	APRIL 12, 1977
C
C	PURPOSE
C	-------
C	DETERMINE IF THE 24 HOUR CLOCK IS PRESENT. IF SO,
C	USE IT TO COMPUTE THE OS/8 DATE AND RESET THE OS/8
C	DATE IF IT DOESN'T MATCH. ALSO PRINT THE TIME OF DAY
C	ON THE DEVICE "JDEV" SPECIFIED IN THE ARGUMENT.
C	IF IDEV=5, THEN DO NOT PRINT THE TIME BUT RETURN
C	THE ABSOLUTE VALUE OF TIME SINCE THE YEAR BEGAN
C	IN SECONDS IN THE FLOATING AC (I.E. TREAT THE 
C	CALL AS A FUNCTION).
C
C	THIS PROGRAM WAS DERIVED FROM DATE.FT.
C
C
S	OPDEF DCAI 3400
S	OPDEF TADI 1400
S	OPDEF MQL 7421
S	OPDEF MQA 7501
S	OPDEF EXADR 6450
S	OPDEF EXIN 6333
C
	DIMENSION TABLE(12), NDAYS(12)
C
C
C	[0.0] INITIALIZE
	IDEV=JDEV
	KHH=0
	KHL=0
	KMH=0
	KML=0
	KSH=0
	KSL=0
	KLO=0
	KMID=0
	KHI=0
	NDATE=0
	KDATE=0
	KDAYS=0
	KLOCK=0
C
C*******NOTE: SET LEAPSW TO 0 WHEN IYEAR=1977
	IYEAR=1978
	LEAPSW=0
C
99	TABLE(1)='JAN'
	TABLE(2)='FEB'
	TABLE(3)='MAR'
	TABLE(4)='APR'
	TABLE(5)='MAY'
	TABLE(6)='JUN'
	TABLE(7)='JUL'
	TABLE(8)='AUG'
	TABLE(9)='SEP'
	TABLE(10)='OCT'
	TABLE(11)='NOV'
	TABLE(12)='DEC'
C
C
	NDAYS(1)=31
	NDAYS(2)=28 + LEAPSW
	NDAYS(3)=31
	NDAYS(4)=30
	NDAYS(5)=31
	NDAYS(6)=30
	NDAYS(7)=31
	NDAYS(8)=31
	NDAYS(9)=30
	NDAYS(10)=31
	NDAYS(11)=30
	NDAYS(12)=31
C
C
C
C	[0.1] GET OS/8 DATE WORD
S	6211		/CDF 10 (FIELD 1)
S	TADI (7666	/LOCATION OF DATE WORD
S	CPAGE 2
S	JMS 45	/RESTORE CURRENT FIELD
S	NOP
S	DCA \NDATE	/SAVE OS/8 DATE WORD
C
C
C
C	[1.0] IF CLOCK PRESENT THEN [2.0]; ELSE [1.1]
S	IAC		/SET ACTO 1
S	EXADR		/IF CLOCK PRESENT THEN AC CLEARED (RTPP MACHINE)
S	SNA CLA	/SKIP IF NOT RIGHT MACHINE
S	JMP \200	/RIGHT MACHINE, LET'S GO TO WORK!
C
C
C	[1.1] IF OS/8 DATE NOT SET, PRINT "NONE" BEFORE EXITING.
S	TAD \NDATE	/GET OS/8 DATE WORD
S	SZA CLA		/SKIP IF NOT SET
S	JMP \400		/DATE BUT NO CLOCK, GO TO PRINTING TIME
	WRITE(IDEV,1111)
1111	FORMAT(' OS/8 DATE NOT SET.')
	RETURN
C

C	[2.0] GET CLOCK DATA
200	KLOCK=1
S 	EXADR		/SET CHANNEL
S	EXIN		/READ DATA
S	DCA \KLO
C
S	CLA IAC		/SET NEXT CHANNEL
S	EXADR
S	EXIN		/GET DATA
S	DCA \KMID
C
S	TAD (2		/SET UP NEXT CHANNEL
S	EXADR
S	EXIN		/GET DATA
S	DCA \KHI
C
C
C	[2.2] UNPACK SECONDS, MINUTES, HOURS, AND DAY
S	TAD \KLO
S	AND (0017
S	DCA \KSL
C
S	TAD \KLO
S	RTR;RTR
S	AND (0017
S	DCA \KSH
C
S	TAD \KLO
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KML
C
S	TAD \KMID
S	AND (0017
S	DCA \KMH
C
S	TAD \KMID
S	RTR;RTR
S	AND (0017
S	DCA \KHL
C
S	TAD \KMID
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KHH
C
S	TAD \KHI
S	AND (0017
S	DCA \KLO
S	TAD \KHI
S	RTR;RTR
S	AND (0017
S	DCA \KMID
S	TAD \KHI
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KHI
	KDAYS=100*KHI+10*KMID+KLO
C
C
C	[2.3] TEST CLOCK DATE FOR VALIDITY
S	TAD \KDAYS	/GET CLOCK DAY
S	SNA CLA		/SKIP IF NON-ZERO
S	JMP \409	/DAY =ZERO=ERROR
	IF(KDAYS-366)240,240,409
C
C
C	[2.4] COMPUTE DATE WORD FROM CLOCK DAY
240	IDAY=KDAYS
	IYEAR=IYEAR-1970
	DO 245 MONTH=1,12
	IDAY=IDAY-NDAYS(MONTH)
	IF(IDAY)247,247,245
245	CONTINUE
247	IDAY=IDAY+NDAYS(MONTH)
S	CLA CLL
S	TAD \MONTH	/GET MONTH NO.
S	RTR;RTR;RAR	/MOVE OVER
S	MQL		/STICK IN MQ
S	TAD \IDAY	/GET DAY OF MONTH
S	RTL;RAL		/MOVE OVER
S	MQA;MQL		/TACK ON & REPLACE IN MQ
S	TAD \IYEAR
S	MQA		/ADD ON REST FROM MQ
S	DCA \KDATE	/FORM CLOCK DATE WORD
C
C
C
C	[3.0] IF CLOCK DATE=OS/8 DATE THEN [4.0];ELSE [3.1]
S	TAD \NDATE	/GET OS/8 DATE WORD
S	CIA		/NEGATE
S	TAD \KDATE	/ADD CLOCK DATE WORD
S	SNA CLA		/SKIP IF NOT EQUAL
S	JMP \400
C
C
C	[3.1] RESET OS/8 DATE
	NDATE=KDATE
S	TAD \NDATE	/GET NEW OS/8 DATE WORD
S	6211		/CDF 10 (FIELD 1)
S	DCAI (7666	/STUFF INTO OS/8 DATE
S	CPAGE 2
S	JMS 45		/RESTORE CURRENT FIELD
S	NOP
C
C
C
C	[4.0] PRINT OUT TIME ON TTY & LPT
400	AMPM='AM'
	NHOURS=10*KHH+KHL
	IF(NHOURS)409,402,403
402	NHOURS=12
	GOTO 407
403	IF(NHOURS-24)404,405,409
404	IF(NHOURS-12)407,406,405
405	NHOURS=NHOURS-12
406	AMPM='PM'
C	IF IDEV =5
C		THEN DO NOT PRINT
S\407,	TAD \IDEV
S	TAD (-5
S	SMA CLA
S	JMP \500 /NO
C	PRINT IT
	WRITE(IDEV,1402)TABLE(MONTH),IDAY,IYEAR
     1,NHOURS,KMH,KML,KSH,KSL,AMPM
1402	FORMAT(1X,A3,1X,I2,', 197',I1
     1,', TIME ',I2,':',2I1,':',2I1,' ',A2)
C
	RETURN
C
C
C	[5] RETURN THE ABS VALUE OF TIME SINCE THE YEAR BEGAN IN
C	SECONDS IN THE FLOAT AC.
500	T=(86400.0*FLOAT(KDAYS)) + (3600.0*FLOAT(10*KHH+KHL)) +
     1 (60.0*FLOAT(10*KMH+KML)) + FLOAT(10*KSH+KSL)
S	CALL 1,FAD
S	ARG \T
	RETURN
C
C
409	WRITE(IDEV,1403)
1403	FORMAT(/,' BAD CLOCK TIME',/)
	RETURN
C
C
C
	END
 