Document title: Fortran routines to convert UCLA-IGPP Cline time Project: ISEE1 and ISEE2 NDADS Datatype: MAG_1M_FF and MAG_4S_FF Super-EID: SOFTWARE There may be other documents also identified by this super-EID. NDADS filename: CTIME.FOR TRF entry: b46644.txt in NSSDC's controlled digital document library, Mar. 1998. Document text follows: ---------------------- C * ------------------------------------------------------------------------- * C * * C * ctime.for - This file contains FORTRAN versions of functions to * C * convert amongst various formats of the UCLA-IGPP time * C * definition called "Cline time". This time is a real*8 value * C * containing the number of seconds since January 1, 1966 at * C * 00:00:00.000. These functions convert to and from real*8 and * C * integer arrays or character strings. * C * * C * Copyright (c) 1975-94 Regents of the University of California. * C * All Rights Reserved. * C * * C * Redistribution and use in source and binary forms are permitted * C * provided that the above copyright notice and this paragraph are * C * duplicated in all such forms and that any documentation, advertising * C * materials, and other materials related to such distribution and use * C * acknowledge that the software was developed by the University of * C * California, Los Angeles. The name of the University may not be used * C * to endorse or promote products derived from this software without * C * specific prior written permission. THIS SOFTWARE IS PROVIDED "AS IS" * C * AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT * C * LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS * C * FOR A PARTICULAR PURPOSE. * C * * C * For information about this software please contact: * C * * C * Principal Investigator: * C * Christopher Russell * C * UCLA - Institute of Geophysics and Planetary Physics * C * 6871 Slichter Hall * C * Los Angeles, Ca. 90024-1567 * C * INTERNET e-mail: ctrussell@igpp.ucla.edu * C * NSI/DECnet e-mail: BRUNET::CTRUSSELL * C * Telephone: (310) 825-3188 * C * * C * Programmer: * C * Harry Herbert * C * UCLA - Institute of Geophysics and Planetary Physics * C * 5833 Slichter Hall * C * Los Angeles, Ca. 90024-1567 * C * INTERNET e-mail: hherbert@igpp.ucla.edu * C * NSI/DECnet e-mail: BRUNET::HARRY * C * Telephone: (310) 825-9030 * C * * C * ------------------------------------------------------------------------- * C*********************************************************************** C MODULE: ACONT C*********************************************************************** C PURPOSE: Convert character time to real*8 time. C C AUTHOR: NEC DATE: 2/13/80 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C L I Number of characters in AT string. C AT Any non-character data type containing ASCII C characters, one to a byte. C T R*8 Returned. Seconds since 1966, Jan 1 00:00:00.000 C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE ACONT (L,AT,T) DOUBLE PRECISION T INTEGER AT(*), IT(8) CALL ACONI (L,AT,IT) CALL ICONT (IT,T) RETURN END C*********************************************************************** C MODULE: ACONI C*********************************************************************** C PURPOSE: Convert character time to integer time array. C C AUTHOR: NEC DATE: 2/10/80 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C L I Number of characters in AT string. C AT Any non-character data type containing ASCII C characters, one to a byte. C IT(8) I Returned. Eight elements containing: C IT(1): Year. Read from first 0-4 uninterrupted C numeric digits. C IT(2): Day of year. Next 0-3 numeric digits. C IT(3): Month. Returned as 1-12 if a 3-or-more-character C month abbreviation was found after the year C or day or year. C IT(4): Day of month. Read from next 1 or 2 numeric C digits after month abbreviation. C IT(5): Hour. Read from next 1 or 2 digits. C IT(6): Minute. Read from next 1 or 2 digits. C IT(7): Seconds. Read from next 1 or 2 digits. C IT(8): Milliseconds. Read from next 0-3 numeric C digits (preceeding decimal point optional, C though not implied). C Note: The returned integer time array may not make any C sense, it is just a decoding of the character string. C For example an input of '1088 999 SEPT 45 44:66:99.666' C will result in an IT of 1088, 999, 9, 45, 44, 66, 99, 666 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C gdm 10/07/86 Changed to look for 4 digit year. C*********************************************************************** SUBROUTINE ACONI (L,AT,IT) INTEGER AT(*), IT(8) K=1 N=NUMST(AT,K,L,4) ! Try for year, up to 4 digits. IT(1)=N IT(2)=0 IT(3)=0 IT(4)=0 N=MONST(AT,K,L) ! Try for ASCII month. IF(N.NE.0) GO TO 30 IT(2)=NUMST(AT,K,L,3) ! No luck, try for day of year. N=MONST(AT,K,L) ! Then try for month. IF(N.EQ.0) GO TO 40 30 IT(3)=N IT(4)=NUMST(AT,K,L,2) ! Got month, try for day of month. 40 IT(5)=NUMST(AT,K,L,2) ! Hour IT(6)=NUMST(AT,K,L,2) ! Minute IT(7)=NUMST(AT,K,L,2) ! Second IT(8)=NUMST(AT,K,L,3) ! Millisecond RETURN END C*********************************************************************** C MODULE: NUMST C*********************************************************************** C PURPOSE: Decode next W digits from A, starting at position C K, but don't go past character L. C AUTHOR: NEC DATE: 2/11/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** FUNCTION NUMST (A,K,L,W) INTEGER A(1), W, X,P,DP,D,ZERO,NINE PARAMETER (ZERO='60'O,NINE='71'O,DP='56'O) C LOGICAL INIT LOGICAL NOND C DATA INIT /.FALSE./ NOND(X) = X.LT.ZERO .OR. X.GT.NINE C USE CONSTANTS FOR ASCII CHARACTERS, INSTEAD OF USING NCHR C ZERO = 60B (48DEC), NINE = 71B (57DEC), DP = 56B (46DEC) C INITIALIZE C IF(INIT) GO TO 10 C INIT=.TRUE. C ZERO=NCHR(1H0,1) C NINE=NCHR(1H9,1) C DP =NCHR(1H.,1) C 10 X=0 D=0 N=0 C SEARCH FOR A DIGIT 20 IF(K.GT.L) GO TO 80 P=X X=NCHR(A,K) K=K+1 IF(NOND(X)) GO TO 20 C FIRST DIGIT FOUND N=X-ZERO D=1 IF(D.EQ.W) GO TO 60 C ACCUMULATE SUBSEQUENT DIGITS 30 IF(K.GT.L) GO TO 60 X=NCHR(A,K) K=K+1 IF(NOND(X)) GO TO 60 N=10*N+X-ZERO D=D+1 IF(D.EQ.W) GO TO 60 GO TO 30 C TAKE CARE OF DEC. PT. IF NECESSARY 60 IF(P.NE.DP) GO TO 80 70 IF(D.EQ.W) GO TO 80 D=D+1 N=10*N GO TO 70 80 NUMST=N RETURN END C*********************************************************************** C MODULE: MONST C*********************************************************************** C PURPOSE: Check next 3 characters in A for a month abbreviation, C starting at position K, don't go past character L. C AUTHOR: NEC DATE: 11/19/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C gdm 10/07/86 Added case folding (HP utility routine CLCUC). c gdm 11/14/87 Added case folding to VAX version. C*********************************************************************** FUNCTION MONST (A,K,L) INTEGER A(1), M(9), X, Y(3), BLANK PARAMETER (BLANK='40'O) DATA M/4HJANF,4HEBMA,4HRAPR,4HMAYJ,4HUNJU,4HLAUG, > 4HSEPO,4HCTNO,4HVDEC/ C DATA M/2HJA,2HNF,2HEB,2HMA,2HRA,2HPR,2HMA,2HYJ,2HUN, C 1 2HJU,2HLA,2HUG,2HSE,2HPO,2HCT,2HNO,2HVD,2HEC/ C C BLANK=NCHR(1H ,1) MONST=0 20 IF(K.GT.L) RETURN X=NCHR(A,K) IF(X.NE.BLANK) GO TO 30 K=K+1 GO TO 20 30 IF(K+2.GT.L) RETURN Y(1)=X Y(2)=NCHR(A,K+1) Y(3)=NCHR(A,K+2) c Convert ASCII to upper case by subtracting decimal 32. do i = 1,3 if (y(i).gt.96) y(i) = y(i) - 32 end do JJ=1 DO 60 N=1,12 J=JJ DO 50 I=1,3 IF( Y(I).NE.NCHR(M,J) ) GO TO 60 50 J=J+1 MONST=N K=K+3 RETURN 60 JJ=JJ+3 RETURN END C*********************************************************************** C MODULE: NCHR C*********************************************************************** C PURPOSE: Place character K of A in right byte of NCHR. C Effectively returns binary value of that character. C C AUTHOR: NEC DATE: 1/11/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** FUNCTION NCHR (A,K) INTEGER A(1) J=(K+3)/4 go to (10,20,30,40) mod(k-1,4)+1 10 NCHR=IAND(A(J),'FF'X) GO TO 50 20 NCHR=IAND(A(J),'FF00'X)/256 GO TO 50 30 NCHR = ISHFT (IAND(A(J),'FF0000'X),-16) GO TO 50 40 NCHR = ISHFT (IAND(A(J),'FF000000'X),-24) 50 RETURN END C*********************************************************************** C MODULE: TNOW C*********************************************************************** C PURPOSE: Return real time from HP system clock. C C AUTHOR: NEC DATE: 1/30/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** DOUBLE PRECISION FUNCTION TNOW () INTEGER*4 ITNOW(2),IT66(2),ITDIFF(2),STATUS,SYS$GETTIM, > SYS$BINTIM,LIB$SUBX DATA IT66/ 1046904832, 7870808/ STATUS = SYS$GETTIM (ITNOW) IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) C STATUS = SYS$BINTIM ('01-JAN-1966 00:00:00.00',IT66) C IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) C WRITE (6,'(2I12)') IT66 STATUS = LIB$SUBX (ITNOW,IT66,ITDIFF) IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) C 2**32 = 4294967296 THEN MULTIPLY BY 1.D-7 TNOW = ISHFT (ITDIFF(1),-1) * 2.D-7 + > ITDIFF(2) * 429.4967296D0 RETURN END C*********************************************************************** C MODULE: TCONA C*********************************************************************** C PURPOSE: Convert real*8 time to character sting. C C AUTHOR: NEC DATE: 1/26/80 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C T R*8 Seconds since 1966, Jan 1 00:00:00.000 C AT Returned. Any non-character data type array at C least 28 bytes long. A string containing ASCII C characters, one to a byte, is returned here. C See ACONI for more info. C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE TCONA (T,AT) DOUBLE PRECISION T INTEGER AT(7), IT(8) CALL TCONI (T,IT) CALL ICONA (IT,AT) RETURN END C*********************************************************************** C MODULE: ICONA C********************************************************************** C PURPOSE: Convert integer array time to a character string. C C AUTHOR: NEC DATE: 1/26/80 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C IT(8) I Integer time array of eight elements: C See ACONI for info. C AT Returned. Any non-character data type array at C least 28 bytes long. A string containing ASCII C characters, one to a byte, is returned here. C See ACONI for more info. C As in ACONI, the time may not make any sense C (ICONA does no error checking, it just formats C what it is given). C This string will be in one of two formats: C (underscore represents a blank) C Years 0-99: _66_032_FEB__1__00:13:59.999 C Years 100-9999: 1966_032_FEB__1_00:13:59.999 C C UPDATES: (WHAT,WHY,WHOM,WHEN) c gdm 10/07/86 Added second format for four digit years. C*********************************************************************** SUBROUTINE ICONA (IT,AT) INTEGER IT(8),AT(7), 1 JT(8),A(28,2), KK1(8,2),KK2(8,2), MA(42), D(-1:9) SAVE JT,A,LF DATA A/1H ,1H6,1H6,1H ,1H0,1H0,1H1,1H ,1HJ,1HA,1HN,1H ,1H ,1H1, 1 1H ,1H ,1H0,1H0,1H:,1H0,1H0,1H:,1H0,1H0,1H.,1H0,1H0,1H0, > 1H1,1H9,1H6,1H6,1H ,1H0,1H0,1H1,1H ,1HJ,1HA,1HN,1H ,1H , 1 1H1,1H ,1H0,1H0,1H:,1H0,1H0,1H:,1H0,1H0,1H.,1H0,1H0,1H0/ 2 ,KK1/2,5, 9,13,17,20,23,26,1,6,10,14,17,20,23,26/ 3 ,KK2/3,7,11,14,18,21,24,28,4,8,12,15,18,21,24,28/ 4 ,MA/1H*,1H*,1H*,1HJ,1HA,1HN,1HF,1HE,1HB,1HM,1HA,1HR, 5 1HA,1HP,1HR,1HM,1HA,1HY,1HJ,1HU,1HN,1HJ,1HU,1HL, 6 1HA,1HU,1HG,1HS,1HE,1HP,1HO,1HC,1HT,1HN,1HO,1HV, 7 1HD,1HE,1HC,1H*,1H*,1H*/ 8 ,D/1H*,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ 9 ,JT/66,1,1,1,0,0,0,0/,LF/1/ C C NF SPECIFIES THE FORMAT: C NF = 1 FOR 2 DIGIT YEARS C EXAMPLE OF OUTPUT: _66_032_FEB_01__00:13:59.999 C NF = 2 FOR 4 DIGIT YEARS C EXAMPLT OF OUTPUT: 1966_032_FEB_01_00:13:59.999 C NF = 1 IF (IT(1).GT.99) NF = 2 DO 60 I=1,8 N=IT(I) IF(N.EQ.JT(I).AND.NF.EQ.LF) GO TO 60 JT(I) = N K1=KK1(I,NF) K2=KK2(I,NF) IF (I.EQ.3) GO TO 50 IF (N.LT.0) GO TO 30 K=K2 10 IF(K.LE.K1) GO TO 20 A(K,NF)=D ( MOD (N,10) ) K=K-1 N=N/10 GO TO 10 20 IF(N.GE.10) GO TO 30 A(K,NF)=D(N) IF(I.EQ.4 .AND. N.EQ.0) A(K,NF)=1H GO TO 60 30 DO 40 K=K1,K2 40 A(K,NF)=1H* GO TO 60 50 M=MAX0(1,MIN0(3*N+1,40)) A(K1,NF)=MA(M) A(K1+1,NF)=MA(M+1) A(K1+2,NF)=MA(M+2) 60 CONTINUE C DO I=1,7 AT(I)= IAND(A(4*I-3,NF),'FF'X) + > ISHFT (IAND(A(4*I-2,NF),'FF'X), 8) + > ISHFT (IAND(A(4*I-1,NF),'FF'X),16) + > ISHFT (IAND(A(4*I ,NF),'FF'X),24) END DO LF = NF RETURN END C*********************************************************************** C MODULE: ICONT C*********************************************************************** C PURPOSE: Convert integer array time to a real*8 time. C C AUTHOR: NEC DATE: 1/24/80 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C IT(8) I Integer time array of eight elements: C The format is the same as described in ACONI. C Years 0-99 represent 1900-1999. If the C day of year is not zero it takes precedence over C the month and day of month. C T R*8 Returned. Seconds since 1966, Jan 1 00:00:00.000 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C*********************************************************************** SUBROUTINE ICONT (IT,T) PARAMETER (DN0=77906.) INTEGER IT(8) DOUBLE PRECISION T C LOGICAL FIRST C DATA FIRST/.TRUE./ C C IF (FIRST) DN0=DAY(1,1,1966) C FIRST=.FALSE. IY=IT(1) c IF (IY.LT. 51) IY=2000+IY IF (IY.LT.100) IY=1900+IY IF(IT(2).EQ.0) THEN DN=DAY(IT(4),IT(3),IY) ELSE DN=DAY(1,1,IY) + IT(2) - 1 END IF T=86400.D0*(DN-DN0) T=T+3600.D0*IT(5)+60.D0*IT(6)+IT(7)+.001D0*IT(8) RETURN END C*********************************************************************** C MODULE: TCONI C*********************************************************************** C PURPOSE: Convert real*8 time to integer array time. C C AUTHOR: NEC DATE: 6/04/81 C C ARGUMENTS TYPE (R=RETURNED) FUNCTION C T R*8 Seconds since 1966, Jan 1 00:00:00.000 C IT(8) I Returned. Eight element integer time array. C The format is the same as described in ACONI. C Years 0-99 represent 1900-1999. C C UPDATES: (WHAT,WHY,WHOM,WHEN) C gdm 10/07/86 Updated to handle negative times (before 1966). C*********************************************************************** SUBROUTINE TCONI(TX,IT) DOUBLE PRECISION T, TX, TD REAL D, DD , DN0 PARAMETER (DN0=77906.) ! Days from Sept 13, 1752 to Jan 1, 1966. INTEGER IT(8), JT(8) INTEGER*4 JD, S, SS C LOGICAL FIRST SAVE DD,SS,JT DATA SS/0/, DD/0./, JT/66,1,1,1,0,0,0,0/ C DATA FIRST /.TRUE./ C IF(FIRST) DN0=DAY(1,1,1966) C FIRST=.FALSE. C C ROUND TO NEAREST MILLISECOND. THIS ROUNDS POSITIVE HALVES UP, C BUT ROUNDS NEGATIVE HALVES DOWN, WHICH IS NOT TECHNICALLY OK BUT C WE'LL LET IT STAY. T = DNINT(TX*1000.D0) C TRUNCATE TO NEXT LOWEST INTEGER (WORKS FOR NEGATIVE TIMES TOO) C ADD A CONSTANT TO MAKE IT POSITIVE, TRUNCATE TO INTEGER, THEN SUBTRACT C THE CONSTANT. C (THE HP CAN COUNT WITH SINGLE PRECISION UP TO 8,388,610. SO THIS C WILL WORK FOR 8388610/365.25 = 22966 YEARS AFTER 1752) TD = T/86400.D3 JD = ABS(TD) + 1. D = DINT (TD + JD) - JD IF(D.EQ.DD) GO TO 20 DD=D CALL DATT (D+DN0,JT(4),JT(3),JT(1)) JT(2)=DAY(JT(4),JT(3),JT(1)) - DAY(1,1,JT(1)) + 1. IF(1899.LT.JT(1).AND.JT(1).LT.2000) JT(1) = JT(1) - 1900 20 S = T - 86400.D3 * D IF(S.EQ.SS) GO TO 30 SS=S JT(8)=MOD(S,1000) S = S/1000 JT(7)=MOD(S,60) S=S/60 JT(6)=MOD(S,60) JT(5)=S/60 30 DO 40 I=1,8 40 IT(I)=JT(I) RETURN END C*********************************************************************** C MODULE: DAY C*********************************************************************** C PURPOSE: Convert a Gregorian calendar date to the number of days C since 13th September 1752. C AUTHOR: NEC DATE: 1/24/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** FUNCTION DAY (IDAY, MONTH, IYEAR) C C I = IYEAR M = MONTH - 3 IF (M .GE. 0) GOTO 10 M = M + 12 I = I - 1 10 K = I / 100 - 16 I = MOD(I, 100) DAY = 36524.0 * FLOAT(K) + 365.0 * FLOAT(I) + * FLOAT(K / 4 + I / 4 + (153 * M + 2) / 5 + IDAY) - 55714.0 RETURN END C*********************************************************************** C MODULE: DATT C*********************************************************************** C PURPOSE: Convert D, which should be positive and integral, C to the corresponding Gregorian date. C AUTHOR: NEC DATE: 1/24/80 C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE DATT (D, IDAY, MONTH, IYEAR) C C DD = D + 445711.0 / 8.0 K = INT((4.0 * DD) / 146097.0) DD = DD - 36524.0 * FLOAT(K) - FLOAT(K / 4) I = INT((4.0 * DD) / 1461.0) DD = DD - 365.0 * FLOAT(I) - FLOAT(I / 4) I = 100 * (K + 16) + I K = INT(5.0 * DD - 1.875) M = K / 153 K = (K - 153 * M + 5) / 5 IF (M .GT. 9) GOTO 10 MONTH = M + 3 GOTO 20 10 MONTH = M - 9 I = I + 1 20 IYEAR = I IDAY = K RETURN END C*********************************************************************** C MODULE: AFIXT C*********************************************************************** C PURPOSE: Some character time strings returned by TCONA have .*** as C the decimal part of seconds, caused by trying to convert the C number 1000 with an I3 format. When ACONT is called the .*** C is ignored, and T is one second less than it should be. C So the fix here is to add one second to T. C AUTHOR: DATE: C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE AFIXT (N,AT,T) C REAL*8 T INTEGER AT(7),A DATA A/'.***'/ CALL ACONT (N,AT,T) IF (N.EQ.28.AND.AT(7).EQ.A) T = T + 1. RETURN END C*********************************************************************** C MODULE: CCONT C*********************************************************************** C PURPOSE: Convert CT, which is a character string representation of C time, to real*8 time. C AUTHOR: DATE: C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE CCONT (CT,T) C CHARACTER*(*) CT DOUBLE PRECISION T INTEGER IT(8) CALL CCONI (CT,IT) CALL ICONT (IT,T) RETURN END C*********************************************************************** C MODULE: CCONI C*********************************************************************** C PURPOSE: Convert CTX, which is a character string representation of C time, to an 8 element integer array. C AUTHOR: DATE: C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE CCONI (CTX,IT) C CHARACTER*(*) CTX CHARACTER*28 CT INTEGER IT(1),AT(7) EQUIVALENCE (CT,AT) CT = CTX CALL ACONI (min(LEN(CTX),28),AT,IT) RETURN END C*********************************************************************** C MODULE: ICONC C*********************************************************************** C PURPOSE: Convert IT, which is an 8 element integer array containing C time, to a character string representation of time. C AUTHOR: DATE: C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE ICONC (IT,CTX) C INTEGER IT(8),AT(7) CHARACTER*(*) CTX CHARACTER*28 CT EQUIVALENCE (CT,AT) CALL ICONA (IT,AT) CTX = CT RETURN END C*********************************************************************** C MODULE: TCONC C*********************************************************************** C PURPOSE: Convert T, which is a real*8 representation of time, to a C character string. C AUTHOR: DATE: C C UPDATES: (WHAT,WHY,WHOM,WHEN) C C*********************************************************************** SUBROUTINE TCONC (T,CT) C CHARACTER*(*) CT DOUBLE PRECISION T INTEGER IT(8) CALL TCONI (T,IT) CALL ICONC (IT,CT) RETURN END C***********************************************************************