Google
 
Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/dumper2/cvtdate.for
There are 2 other files named cvtdate.for in the archive. Click here to see a list.
	SUBROUTINE CVTDATE(DATE,LINE,LINEL)
C
C	TO CONVERT UNIVERSAL DATE/TIME FOR THE DEC-10
C	INTO A PRINTABLE STRING.  THE UNIVERSAL DATE
C	TIME IS:
C	LEFT HALF -- NUMBER OF DAYS FROM 17-NOV-1858
C	RIGHT HALF -- FRACTIONAL DAY
C
	INTEGER DATE(2)
	BYTE LINE(256)
	INTEGER LINEL
	INTEGER DAYS,FRAC
	INTEGER IDAY,IDAYS,YEAR,HOUR,MIN,ISECS,LEAP,QUADS
	CHARACTER MONTH*3
	REAL SECS
	BYTE CDATE(20)
	CHARACTER*20 DATEC
	EQUIVALENCE (DATEC,CDATE)
C
	CALL CVTHALF(DATE,FRAC,DAYS)
	DAYS = DAYS+321
	QUADS = DAYS/1461
	DAYS = DAYS-QUADS*1461
	YEAR = QUADS*4
	LEAP = 0
	IF (DAYS.GT.1095) THEN
	 YEAR = YEAR+1861
	 DAYS = DAYS-1096
	ELSE IF (DAYS.GT.730) THEN
	 YEAR = YEAR+1860
	 DAYS = DAYS-730
	 LEAP = 1
	ELSE IF (DAYS.GT.364) THEN
	 YEAR = YEAR+1859
	 DAYS = DAYS-365
	ELSE
	 YEAR = YEAR+1858
	ENDIF
	IDAYS = DAYS+1
	IF (LEAP+152.GT.IDAYS) THEN
	 IF (LEAP+60.GT.IDAYS) THEN
	  IF (32.GT.IDAYS) THEN
	   MONTH = 'JAN'
	   IDAY = IDAYS
	  ELSE
	   MONTH = 'FEB'
	   IDAY = IDAYS-31
	  ENDIF
	 ELSE IF (LEAP+91.GT.IDAYS) THEN
	  MONTH = 'MAR'
	  IDAY = IDAYS-(59+LEAP)
	 ELSE IF (LEAP+121.GT.IDAYS) THEN
	  MONTH = 'APR'
	  IDAY = IDAYS-(90+LEAP)
	 ELSE
	  MONTH = 'MAY'
	  IDAY = IDAYS-(120+LEAP)
	 ENDIF
	ELSE
	 IF (LEAP+244.GT.IDAYS) THEN
	  IF (LEAP+182.GT.IDAYS) THEN
	   MONTH = 'JUN'
	   IDAY = IDAYS-(151+LEAP)
	  ELSE IF (LEAP+213.GT.IDAYS) THEN
	   MONTH = 'JUL'
	   IDAY = IDAYS-(181+LEAP)
	  ELSE
	   MONTH = 'AUG'
	   IDAY = IDAYS-(212+LEAP)
	  ENDIF
	 ELSE IF (LEAP+305.GT.IDAYS) THEN
	  IF (LEAP+274.GT.IDAYS) THEN
	   MONTH = 'SEP'
	   IDAY = IDAYS-(243+LEAP)
	  ELSE
	   MONTH = 'OCT'
	   IDAY = IDAYS-(273+LEAP)
	  ENDIF
	 ELSE IF (LEAP+335.GT.IDAYS) THEN
	  MONTH = 'NOV'
	  IDAY = IDAYS-(304+LEAP)
	 ELSE
	  MONTH = 'DEC'
	  IDAY = IDAYS-(334+LEAP)
	 ENDIF
	ENDIF
	SECS = (FRAC*27*25)/(2**11)
	HOUR = IFIX(SECS)/(60*60)
	MIN = MOD(IFIX(SECS)/60,60)
	ISECS = MOD(IFIX(SECS),60)
	WRITE(DATEC,10) IDAY,MONTH,YEAR,HOUR,MIN,ISECS
10	FORMAT(I2,'-',A3,'-',I4,' ',I2.2,':',I2.2,':',I2.2)
	DO I=1,20,1
	LINE(LINEL+I-1) = CDATE(I)
	ENDDO
	LINEL = LINEL+20
	RETURN
	END