Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-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