C     utdate.f 2.1 9/4/91
C
C
C
      SUBROUTINE   CKDATE
     I                    (DATE1, DATE2,
     O                     FLAG)
C
C     + + + PURPOSE + + +
C     Determine the calendar order of two dates.  The dates are
C     assumed to be valid.
C     Examples:      DATE1               DATE2         FLAG
C              1980/10/1 00:00:00  1980/10/1 24:00:00   -1
C              1980/10/1 24:00:00  1980/10/1 00:00:00    1
C              1980/10/1 24:00:00  1980/10/2 00:00:00   -1
C              1980/10/2 00:00:00  1980/10/1 24:00:00    1
C              1980/10/1 24:00:00  1980/10/1 24:00:00    0
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6), DATE2(6), FLAG
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - first date
C     DATE2  - second date
C     FLAG   - flag indicating order of dates
C               1 - DATE1 follows DATE2
C               0 - DATE1 is the same date as DATE2
C              -1 - DATE2 follows DATE1
C
C     + + + LOCAL VARIABLES + + +
      INTEGER  I
C
C     + + + END SPECIFICATIONS + + +
C
      FLAG = -99
      I = 0
C
 10   CONTINUE
        I = I + 1
C
        IF (DATE1(I) .LT. DATE2(I)) THEN
C         first date is before second date
          FLAG = -1
        ELSE
C         first date follows or equals second date
          IF (DATE1(I) .GT. DATE2(I)) THEN
C           first date follows second date
            FLAG = 1
          ELSE IF (I .EQ. 6) THEN
C           all parts of dates are equal
            FLAG = 0
          END IF
        END IF
C
      IF (I.LT.6 .AND. FLAG.EQ.-99) GO TO 10
C
      RETURN
      END
C
C
C
      SUBROUTINE   CMPTIM
     I                   ( TCODE1, TSTEP1, TCODE2, TSTEP2,
     O                     TSTEPF, TCDCMP )
C
C     + + + PURPOSE + + +
C     Compare one time unit and step to a second time unit and
C     step.  Two flags are returned.  The first flag indicates
C     compatible/incompatible time steps.  The second flag
C     indicates which time step is smaller.  Time steps are
C     considered compatible if one is an even multiple of the
C     other.  One hour and 30 minutes are compatible; one hour
C     and 90 minutes are incompatible.  Comparison of time units
C     and time steps which cross the day-month boundry are handled
C     a little different.  If the smaller time step is a day or
C     less and is compatible with 1 day and the larger time step
C     is compatible with one month, than the smaller and the
C     larger time steps are considered to be compatible.  The time
C     step of a day or less will be considered to be the smaller
C     time step.
C     EXAMPLES:  TCODE1 TSTEP1 TCODE2 TSTEP2 TSTEPF TCDCMP
C                  3      1      2      60     0      0
C                  3      1      2      90     1      1
C                  3      1      2      30     0      2
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER  TCODE1, TSTEP1, TCODE2, TSTEP2, TSTEPF, TCDCMP
C
C     + + + ARGUMENT DEFINITIONS + + +
C     TCODE1 - time units code
C              1 - second    4 - day
C              2 - minute    5 - month
C              3 - hour      6 - year
C     TSTEP1 - time step, in TCODE1 units
C     TCODE2 - time units code
C              1 - second    4 - day
C              2 - minute    5 - month
C              3 - hour      6 - year
C     TSTEP2 - time step in TCODE2 units
C     TSTEPF - time step compatability flag
C              0 - compatible time steps
C              1 - incompatible time steps
C     TCDCMP - flag indicating order of time steps
C               0 - time steps are the same
C               1 - first time step is smaller
C               2 - second time step is smaller
C              -1 - time units span day-month boundry
C
C     + + + LOCAL VARIABLES + + +
      INTEGER    TC(2), TS(2), TSX, TCX, TSFX(2), TCDX(2)
C
C     + + + EXTERNALS + + +
      EXTERNAL   CMPTM2
C
C     + + + END SPECIFICATIONS + + +
C
      TC(1) = TCODE1
      TC(2) = TCODE2
      TS(1) = TSTEP1
      TS(2) = TSTEP2
C
      IF (TC(1) .LT. 1  .OR.  TC(1) .GT. 6     .OR.
     >    TC(2) .LT. 1  .OR.  TC(2) .GT. 6     .OR.
     >    TS(1) .LT. 1  .OR.  TS(1) .GT. 1440  .OR.
     >    TS(2) .LT. 1  .OR.  TS(2) .GT. 1440) THEN
C       an invalid time units code or time step
        TSTEPF = 1
        TCDCMP = -1
      ELSE IF ((TC(1) .LE. 4  .AND.  TC(2) .GE. 5)  .OR.
     >         (TC(2) .LE. 4  .AND.  TC(1) .GE. 5)) THEN
C       special case for time units that cross day-month boundry
        TSTEPF = 1
        TCDCMP = -1
        IF (TC(1) .LE. 4) THEN
C         first time unit is day or smaller, second is month or larger
          TSX = 1
          TCX = 4
          CALL CMPTM2 ( TC(1), TS(1), TCX, TSX, TSFX(1), TCDX(1) )
          TSX = 1
          TCX = 5
          CALL CMPTM2 ( TC(2), TS(2), TCX, TSX, TSFX(2), TCDX(2) )
          IF (TSFX(1) .EQ. 0  .AND.  TSFX(2) .EQ. 0) THEN
C           times compatible with boundaries
            IF ((TCDX(1) .EQ. 0  .OR.  TCDX(1) .EQ. 1)  .AND.
     >          (TCDX(2) .EQ. 0  .OR.  TCDX(2) .EQ. 2)) THEN
C             smaller time a day or less, larger time a month or more
              TSTEPF = 0
              TCDCMP = 1
            END IF
          END IF
        ELSE
C         second time unit is day or smaller, first is month or larger
          TSX = 1
          TCX = 5
          CALL CMPTM2 ( TC(1), TS(1), TCX, TSX, TSFX(1), TCDX(1) )
          TSX = 1
          TCX = 4
          CALL CMPTM2 ( TC(2), TS(2), TCX, TSX, TSFX(2), TCDX(2) )
          IF (TSFX(1) .EQ. 0  .AND.  TSFX(2) .EQ. 0) THEN
C           times compatible with boundaries
            IF ((TCDX(1) .EQ. 0  .OR.  TCDX(1) .EQ. 2)  .AND.
     >          (TCDX(2) .EQ. 0  .OR.  TCDX(2) .EQ. 1)) THEN
C             larger time a month or more, smaller time a day or less
              TSTEPF = 0
              TCDCMP = 2
            END IF
          END IF
        END IF
      ELSE
C       valid time steps and units do not cross day-month boundry
        CALL CMPTM2 ( TC(1), TS(1), TC(2), TS(2), TSTEPF, TCDCMP )
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   CMPTM2
     M                   ( TC1, TS1, TC2, TS2,
     O                     TSTEPF, TCDCMP )
C
C     + + + PURPOSE + + +
C     This routine compares one time unit and step to a second time
C     unit and step.  Two flags are returned.  The first flag
C     indicates compatible/incompatible time steps.  The second flag
C     indicates which timestep is smaller.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER  TC1, TC2, TS1, TS2, TSTEPF, TCDCMP
C
C     + + + ARGUMENT DEFINITIONS + + +
C     TC1    - time units code
C              1 - second    4 - day
C              2 - minute    5 - month
C              3 - hour      6 - year
C     TS1    - time step, in TC1 units
C     TC2    - time units code, see TC1
C     TS2    - time step, in TC2 units
C     TSTEPF - time step compatability flag
C              0 - compatible time series
C              1 - incompatible time steps
C     TCDCMP - flag indicating order of time steps
C               0 - time steps are the same
C               1 - first time step is smaller
C               2 - second time step is smaller
C              -1 - time units span day-month boundry
C
C     + + + LOCAL VARIABLES + + +
      INTEGER    CONVDN(7)
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + DATA INITIALIZATIONS + + +
      DATA  CONVDN / 0, 60, 60, 24, 0, 12, 100 /
C
C     + + + END SPECIFICATIONS + + +
C
      IF ((TC1 .LE. 4  .AND.  TC2 .GT. 4)  .OR.
     >    (TC1 .GT. 4  .AND.  TC2 .LE. 4)) THEN
C       time units span day-month boundry
        TSTEPF = 1
        TCDCMP = -1
      ELSE
C       acceptable time units
        IF (TC1 .NE. TC2) THEN
C         time units not same, adjust larger to agree with smaller
          IF (TC1 .LT. TC2) THEN
C           Adjust second time units to agree with first
 100        CONTINUE
              TS2 = TS2 * CONVDN(TC2)
              TC2 = TC2 - 1
            IF (TC1 .LT. TC2) GO TO 100
          ELSE
C           Adjust first time units to agree with second
 120        CONTINUE
              TS1 = TS1 * CONVDN(TC1)
              TC1 = TC1 - 1
            IF (TC2 .LT. TC1) GO TO 120
          END IF
        END IF
C
C       Time units converted, check time step
        TSTEPF = 0
        IF (TS1 .EQ. TS2) THEN
C         Same time step
          TCDCMP = 0
        ELSE IF (TS1 .LT. TS2) THEN
C         First time step smaller
          TCDCMP = 1
          IF (MOD(TS2,TS1) .NE. 0) TSTEPF = 1
        ELSE
C         Second time step smaller
          TCDCMP = 2
          IF (MOD(TS1,TS2) .NE. 0) TSTEPF = 1
        END IF
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   DATCHK
     I                   (DATE,
     O                    ERROR)
C
C     + + + PURPOSE + + +
C     Check DATE for valid entries.  For each valid element in
C     DATE, the corresponding element in ERROR is set to zero.
C     For each invalid element in DATE, the corresponding element
C     in ERROR is set to one.
C     Valid date elements are:
C       1800 <= year   <= 2080
C         1  <= month  <= 12
C         1  <= day    <= 31 or as appropriate for month and year
C         0  <= hour   <= 24
C         0  <= minute <= 60
C         0  <= second <= 60
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE(6),ERROR(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE   - Date to be checked
C     ERROR  - Array containing flags for valid DATE elements:
C              0 - good, 1 - invalid
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   I,J,DS,YR,MO,DY,HR,MI,SC
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL   DAYMON, ZIPI
C
C     + + + END SPECIFICATIONS + + +
C
      YR = DATE(1)
      MO = DATE(2)
      DY = DATE(3)
      HR = DATE(4)
      MI = DATE(5)
      SC = DATE(6)
C
      I= 6
      J= 0
      CALL ZIPI (I,J,ERROR)
C
C     check range on each number
      IF (YR.LT.1800.OR.YR.GE.2080) THEN
        ERROR(1) = 1
      END IF
      IF (MO.LT.1.OR.MO.GT.12) THEN
        ERROR(2) = 1
        DS = 31
      ELSE
        DS = DAYMON(YR,MO)
      END IF
      IF (DY.LT.1.OR.DY.GT.DS) THEN
        ERROR(3) = 1
      END IF
      IF (HR.LT.0.OR.HR.GT.24) THEN
        ERROR(4) = 1
      END IF
      IF (MI.LT.0.OR.MI.GT.60) THEN
        ERROR(5) = 1
      END IF
      IF (SC.LT.0.OR.SC.GT.60) THEN
        ERROR(6) = 1
      END IF
C
C     if day or month are zero, then hour,min,sec should be zero
      IF (MO.EQ.0.AND.DY.NE.0) ERROR(3) = 1
      IF (MO.EQ.0.AND.HR.NE.0) ERROR(4) = 1
      IF (MO.EQ.0.AND.MI.NE.0) ERROR(5) = 1
      IF (MO.EQ.0.AND.SC.NE.0) ERROR(6) = 1
      IF (DY.EQ.0.AND.HR.NE.0) ERROR(4) = 1
      IF (DY.EQ.0.AND.MI.NE.0) ERROR(5) = 1
      IF (DY.EQ.0.AND.SC.NE.0) ERROR(6) = 1
C
      RETURN
      END
C
C
C
      SUBROUTINE   DATNXT
     I                   (INTRVL,UPBACK,
     M                    DATE)
C
C     + + + PURPOSE + + +
C     Based on the value of UPBACK, this routine adds or subtracts
C     the time interval INTRVL from the current date and time DATE.
C     The time convention has midnite as 24:00 of previous day, not
C     as 00:00 of next day.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE(6),UPBACK
      INTEGER(4)INTRVL
C
C     + + + ARGUMENT DEFINITIONS + + +
C     INTRVL - time step, in minutes
C     UPBACK - flag indicating direction in time to move:
C              >0  - move forward in time
C              <=0 - move back in time
C     DATE   - date to be modified
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   YEAR,MONTH,DAY,HR,MIN,SEC
      INTEGER(4)DHR,DMIN,TT,I4T24,I4T60,I4T0
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + EXTERNALS + + +
      EXTERNAL   DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
      I4T24= 24
      I4T60= 60
      I4T0 = 0
C
      YEAR = DATE(1)
      MONTH = DATE(2)
      DAY = DATE(3)
      HR = DATE(4)
      MIN = DATE(5)
      SEC = DATE(6)
C
      DMIN = MIN
      DHR = HR
C
      IF (UPBACK.GT.0) THEN
C       move forward in time
        DMIN = DMIN + INTRVL
        IF (DMIN.LT.I4T60.AND.DHR.LT.I4T24) GO TO 49
          TT = DMIN/60
          DMIN = DMIN - TT*60
          DHR = DHR + TT
          IF (DHR.LT.I4T24) GO TO 48
          IF (DHR.EQ.I4T24.AND.DMIN.EQ.I4T0) GO TO 48
            TT = DHR/24
C           special case for daily timestep to keep convention
            IF (MOD(DHR,I4T24).EQ.0.AND.DMIN.EQ.I4T0) TT = TT-1
            DHR = DHR - TT*24
            DAY = DAY + TT
 40         CONTINUE
            IF (DAY.GT.DAYMON(YEAR,MONTH)) THEN
              DAY = DAY - DAYMON(YEAR,MONTH)
              MONTH = MONTH + 1
              IF (MONTH.GT.12) THEN
                MONTH = 1
                YEAR = YEAR + 1
              END IF
              GO TO 40
            END IF
 48       CONTINUE
 49     CONTINUE
      ELSE
C       move back in time
        DMIN = DMIN - INTRVL
        IF (DMIN.LE.I4T0) THEN
          TT = DMIN/60 - 1
          DMIN = DMIN-TT*60
          DHR = DHR + TT
          IF (DMIN.EQ.I4T60) THEN
            DMIN = 0
            DHR = DHR + 1
          END IF
          IF (DHR.LE.I4T0) THEN
            TT = DHR/24 - 1
            DHR = DHR-TT*24
            DAY = DAY + TT
  70        CONTINUE
            IF (DAY.LE.0) THEN
              MONTH = MONTH - 1
              IF (MONTH.LE.0) THEN
                MONTH = 12
                YEAR = YEAR - 1
              END IF
              DAY = DAYMON(YEAR,MONTH) + DAY
              GO TO 70
            END IF
          END IF
        END IF
      END IF
C
      MIN = DMIN
      HR = DHR
      DATE(1) = YEAR
      DATE(2) = MONTH
      DATE(3) = DAY
      DATE(4) = HR
      DATE(5) = MIN
      DATE(6) = SEC
C
      RETURN
      END
C
C
C
      INTEGER   FUNCTION   DAYMON
     I                           (YR,MON)
C
C     + + + PURPOSE + + +
C     Return the number of days in the given month for the given
C     year, with leap year taken into account.  For an invalid
C     month, -1 is returned.  For an invalid year and a valid month,
C     the correct number of days is returned, with February = 28.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER    MON,YR
C
C     + + + ARGUMENT DEFINITIONS + + +
C     YR     - year, valid range is 1 - 2080
C     MON    - month, valid range is 1 - 12
C
C     + + + LOCAL VARIABLES + + +
      INTEGER     I4,I100,I400,NDAMON(12)
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + DATA INITIALIZATIONS + + +
      DATA NDAMON/31,28,31,30,31,30,31,31,30,31,30,31/
C
C     + + + END SPECIFICATIONS + + +
C
CJLK  CALL DCALCT(5)
      I4 = 4
      I100 = 100
      I400 = 400
      IF (MON.EQ.2) THEN
        IF (YR .LE. 0  .OR.  YR .GT. 9999) THEN
C         invalid year
          DAYMON = 28
        ELSE IF (MOD(YR,I100).EQ.0) THEN
C         check whether this is a leap year on a century boundary
          IF (MOD(YR,I400).EQ.0) THEN
C           on a 400 year boundary
            DAYMON = 29
          ELSE
            DAYMON = 28
          END IF
        ELSE
          IF (MOD(YR,I4).EQ.0) THEN
C           leap year
            DAYMON = 29
          ELSE
            DAYMON = 28
          END IF
        END IF
C
      ELSE IF (MON.GE.1 .AND. MON.LE.12) THEN
C       no problem
        DAYMON = NDAMON(MON)
      ELSE
C       invalid month
        DAYMON = -1
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   DLIMIT
     I                   ( DATES, NDSN, FSLS,
     O                     DATE )
C
C     + + + PURPOSE + + +
C     Depending on the value of FSLS, find the earliest or
C     latest date in the array of dates DATES.  CKDATE is
C     used to determine the calendar order between dates.
C     The dates are assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   NDSN, FSLS, DATE(6)
      INTEGER   DATES(6,NDSN)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATES  - array of NDSN dates
C     NDSN   - number of dates
C     FSLS   - indicator for type of date to look for
C              1 - finds first date
C              2 - finds last date
C     DATE   - depending on the value of FSLS, the first or last
C              date in DATES
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   N, FLG, L
C
C     + + + EXTERNALS + + +
      EXTERNAL   CKDATE, COPYI
C
C     + + + END SPECIFICATIONS + + +
C
C     assume first/last
      L = 6
      CALL COPYI ( L, DATES, DATE )
      IF (FSLS .EQ. 1) THEN
C       find any before assumed first
        DO 100 N = 2, NDSN
          CALL CKDATE( DATE, DATES(1,N), FLG )
          IF (FLG .EQ. 1) THEN
C           new first
            CALL COPYI (L,DATES(1,N),DATE)
          END IF
 100    CONTINUE
      ELSE IF (FSLS .EQ. 2) THEN
C       find any after assumed last
        DO 200 N = 1, NDSN
          CALL CKDATE( DATE, DATES(1,N), FLG )
          IF (FLG .EQ. -1) THEN
C           new last
            CALL COPYI (L,DATES(1,N),DATE)
          END IF
 200    CONTINUE
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   JDMODY
     I                    (YEAR,JDAY,
     O                     MON,DAY)
C
C     + + + PURPOSE + + +
C     Convert a julian day to month and day, leap year taken
C     into account.  YEAR and JDAY are assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   YEAR,JDAY,MON,DAY
C
C     + + + ARGUMENT DEFINITIONS + + +
C     YEAR   - year
C     JDAY   - julian date
C     MON    - month
C     DAY    - day
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   LPFG,MOCUM(12,2)
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + DATA INITIALIZATIONS + + +
      DATA MOCUM /31,59,90,120,151,181,212,243,273,304,334,365,
     1            31,60,91,121,152,182,213,244,274,305,335,366/
C
C     + + + END SPECIFICATIONS + + +
C
C     check for leap year
      LPFG= 1
Cy2k  IF (MOD(YEAR,4).EQ.0.AND.MOD(YEAR,100).NE.0) LPFG= 2
      IF (MOD(YEAR,4).EQ.0.AND.
     1   (MOD(YEAR,100).NE.0.OR.MOD(YEAR,400).EQ.0)) LPFG= 2
C
      MON= 0
 10   CONTINUE
        MON= MON+ 1
      IF (JDAY.GT.MOCUM(MON,LPFG)) GOTO 10
C
      DAY= JDAY
      IF (MON.GT.1) DAY= JDAY- MOCUM(MON-1,LPFG)
C
      RETURN
      END
C
C
C
      SUBROUTINE   NUMPTS
     I                   (DATE1,DATE2,DELT,
     O                    NPTS)
C
C     + + + PURPOSE + + +
C     Calculate the number of time steps between two dates.
C     If the second date is before the first date, a zero is
C     returned.  The first date is assumed to be at the end
C     of the first time step.  The dates are assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6),DATE2(6),DELT,NPTS
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - first (start) date
C     DATE2  - second (end) date
C     DELT   - time step, in minutes
C     NPTS   - number of time steps between first and second date
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   NPD,YR,M,SYR,SMO,SDY,SHR,SMI,EYR,EMO,EDY,EHR,EMI,
     1          ERRFLG
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL   CKDATE, DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
      SYR = DATE1(1)
      SMO = DATE1(2)
      SDY = DATE1(3)
      SHR = DATE1(4)
      SMI = DATE1(5)
      EYR = DATE2(1)
      EMO = DATE2(2)
      EDY = DATE2(3)
      EHR = DATE2(4)
      EMI = DATE2(5)
C
      NPTS = 0
C     number per day
      NPD = 1440/DELT
      YR = SYR
      M = SMO
C
C     if end date before start date, return npts of 0
      CALL CKDATE (DATE1,DATE2,ERRFLG)
      IF (ERRFLG.LE.0) THEN
C
        IF (SMO.LT.EMO.OR.YR.LT.EYR) THEN
C         start and stop not same month
          NPTS = NPTS + (DAYMON(SYR,SMO)+1-SDY)*NPD
C
C         middle months
 56       CONTINUE
            M = M + 1
            IF (M.GT.12) THEN
              M = 1
              YR = YR + 1
            END IF
C
            IF (M.EQ.EMO.AND.YR.GE.EYR) GO TO 58
              NPTS = NPTS + DAYMON(YR,M)*NPD
              GO TO 56
C
 58       CONTINUE
C         final month
          NPTS = NPTS + EDY*NPD
        ELSE
C         start and stop in the same month
          NPTS = NPTS + (EDY+1-SDY)*NPD
        END IF
C
C       have correct number of days
        IF (NPD.GT.1) THEN
C         for timesteps less than one day
C         first day
          NPTS = NPTS - (SHR*60 + SMI)/DELT + 1
C         last day
          NPTS = NPTS - ((23-EHR)*60 + (60-EMI))/DELT
        END IF
C
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMADD
     I                    (DATE1,TCODE,TSTEP,NVALS,
     O                     DATE2)
C
C     + + + PURPOSE + + +
C     Add NVALS time steps to first date to compute second date.
C     The first date is assumed to be valid.
C
C     + + + HISTORY + + +
C     jlk 00/04/12  fix problem where time was coming up 24:15:00
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6),TCODE,TSTEP,DATE2(6)
      INTEGER   NVALS
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - starting date
C     TCODE  - time units
C              1 - second          5 - month
C              2 - minute          6 - year
C              3 - hour            7 - century
C              4 - day
C     TSTEP  - time step in TCODE units
C     NVALS  - number of time steps to be added
C     DATE2  - new date
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   CARRY,DPM,TYR,TMO,TDY,THR,TMN,TSC,STPOS,DONFG
      INTEGER   I,DATEL1(6)
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL  DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
CJLK  CALL DCALCT(1)
Ckmf
Ckmf  write(99,*) '      timadd:  date1 =', date1
Ckmf  write(99,*) '               date2 =', date2
Ckmf  write(99,*) '               tcode =', tcode
Ckmf  write(99,*) '               tstep =', tstep
Ckmf  write(99,*) '               nvals =', nvals
Ckmf
C
C     make a local copy of start date as it might change
      DO 10 I= 1,6
        DATEL1(I)= DATE1(I)
 10   CONTINUE
Ckmf  IF (DATEL1(4).EQ.24) THEN
      IF (TCODE.LT.4 .AND. DATEL1(4).EQ.24) THEN
C       convert local start date to midnight is 0 convention
        CALL TIMCVT(DATEL1)
      END IF
C
      TYR= DATEL1(1)
      TMO= DATEL1(2)
      TDY= DATEL1(3)
      THR= DATEL1(4)
      TMN= DATEL1(5)
      TSC= DATEL1(6)
C
C     figure out how much time to add and where to start
      CARRY= NVALS* TSTEP
      STPOS= TCODE
      IF (STPOS.EQ.7) THEN
C       the time units are centuries, convert to years
        STPOS= 6
        CARRY= CARRY* 100
      END IF
C
C     add the time, not changing insig. parts
      IF (STPOS.EQ.1) THEN
C       seconds
        TSC  = TSC+ CARRY
        CARRY= TSC/ 60
        TSC  = TSC- (CARRY*60)
      END IF
      IF (STPOS.LE.2 .AND. CARRY.GT.0) THEN
C       minutes
        TMN  = TMN+ CARRY
        CARRY= TMN/ 60
        TMN  = TMN- (CARRY*60)
      END IF
      IF (STPOS.LE.3 .AND. CARRY.GT.0) THEN
C       hours
        THR  = THR+ CARRY
        CARRY= THR/ 24
        THR  = THR- (CARRY*24)
        IF (THR.EQ.0 .AND.TMN.EQ.0.AND. TSC.EQ.0) THEN
C         this is the day boundry problem
          THR  = 24
          CARRY= CARRY- 1
        END IF
      END IF
      IF (STPOS.LE.4 .AND. CARRY.GT.0) THEN
C       days
        TDY  = TDY+ CARRY
        IF (TDY.GT.28) THEN
C         may need month/year adjustment
          DONFG= 0
 45       CONTINUE
CJLK        CALL DCALCT(4)
            DPM= DAYMON(TYR,TMO)
            IF (TDY .GT. DPM) THEN
C             add another month
              TDY= TDY- DPM
              TMO= TMO+ 1
              IF (TMO .GT. 12) THEN
                TMO= 1
                TYR= TYR+ 1
              END IF
            ELSE IF (TDY .LE. 0) THEN
C             subtract another month
              TMO= TMO- 1
              IF (TMO .EQ. 0) THEN
                TYR= TYR- 1
                TMO= 12
              END IF
              TDY= TDY- DAYMON(TYR,TMO)
            ELSE
              DONFG= 1
            END IF
          IF (DONFG.EQ.0) GO TO 45
        END IF
C       month and year updated here all done
      END IF
C
      IF (STPOS.GE.5) THEN
        IF (STPOS.EQ.5) THEN
C         months
          TMO  = TMO+ CARRY
          CARRY= (TMO-1)/ 12
          TMO  = TMO- (CARRY*12)
        END IF
        IF (STPOS.LE.6 .AND. CARRY.GT.0) THEN
C         years
          TYR  = TYR+ CARRY
        END IF
C
C       check days/month
        DPM= DAYMON(TYR,TMO)
        IF (DPM .LT. TDY) THEN
          TDY= DPM
        END IF
        IF (DAYMON(DATE1(1),DATE1(2)).EQ.DATE1(3)) THEN
          TDY= DPM
        END IF
      END IF
C
      DATE2(1)= TYR
      DATE2(2)= TMO
      DATE2(3)= TDY
      DATE2(4)= THR
      DATE2(5)= TMN
      DATE2(6)= TSC
Ckmf  try commenting just this part out
Ckmf  IF (DATE2(4).EQ.24) THEN
Ckmf    convert to midnight is 0 convention
Ckmf    CALL TIMCVT(DATE2)
Ckmf  END IF
Ckmf
Ckmf  write(99,*) '        done:  date2 =', date2
Ckmf
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMBAK
     I                    (TCODE,
     M                     DATE)
C
C     + + + PURPOSE + + +
C     Subtract one time interval at the given units TCODE from DATE.
C     The date is assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   TCODE,DATE(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     TCODE  - time units code
C              1 - seconds            5 - months
C              2 - minutes            6 - years
C              3 - hours              7 - centuries
C              4 - days
C     DATE   - date
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   DONE,I,NEWDAY
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL   DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
      I     = TCODE
      NEWDAY= 0
C
 5    CONTINUE
C
        GO TO (10,20,30,40,50,60,70),I
C
 10     CONTINUE
C         seconds
          DATE(6)  = DATE(6)-1
          IF (DATE(6).LT.0) THEN
            DATE(6)= 59
            I     = I+ 1
            DONE  = 0
          ELSE
            DONE  = 1
          END IF
          GO TO 80
C
 20     CONTINUE
C         minutes
          DATE(5)  = DATE(5)-1
          IF (DATE(5).LT.0) THEN
            DATE(5)= 59
            I     = I+ 1
            DONE  = 0
          ELSE
            DONE  = 1
          END IF
          GO TO 80
C
 30     CONTINUE
C         hours
          DATE(4)  = DATE(4)-1
          IF (DATE(4).LT.0) THEN
            DATE(4)= 23
            I     = I+ 1
            DONE  = 0
          ELSE IF (DATE(4).EQ.0.AND.DATE(5).EQ.0.AND.DATE(6).EQ.0) THEN
            DATE(4)= 24
            I     = I+ 1
            DONE  = 0
          ELSE
            DONE= 1
          END IF
          GO TO 80
C
 40     CONTINUE
C         days
          DATE(3)= DATE(3)-1
          IF (DATE(3).LE.0) THEN
            NEWDAY= 1
            I   = I+ 1
            DONE= 0
          ELSE
            DONE= 1
          END IF
          GO TO 80
C
 50     CONTINUE
C         months
          DATE(2)= DATE(2)-1
          IF (DATE(2).LE.0) THEN
            DATE(2)= 12
            I   = I+ 1
            DONE= 0
          ELSE
            DONE= 1
          END IF
          GO TO 80
C
 60     CONTINUE
C         years
          DATE(1)= DATE(1)-1
          DONE= 1
          GO TO 80
C
 70     CONTINUE
C         centuries
          DATE(1)= DATE(1)-100
          DONE= 1
          GO TO 80
C
 80     CONTINUE
      IF (DONE.EQ.0) GO TO 5
C
      IF (NEWDAY.EQ.1) THEN
        DATE(3)= DAYMON(DATE(1),DATE(2))
      END IF
C
      RETURN
      END
C
C
C
      INTEGER   FUNCTION   TIMCHK
     I                            (DATE1,DATE2)
C
C     + + + PURPOSE + + +
C     Determine the calendar order of two dates.
C     The dates are assumed to be valid.
C     TIMCHK = 1 if DATE1 < DATE2
C            = 0 if DATE1 = DATE2
C            =-1 if DATE1 > DATE2
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6),DATE2(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - first date
C     DATE2  - second date
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   I,SDAT(6),EDAT(6),LEN
C
C     + + + EQUIVALENCES + + +
      EQUIVALENCE (SDAT(1),SYR),(SDAT(2),SMO),(SDAT(3),SDY),
     #            (SDAT(4),SHR),(SDAT(5),SMN),(SDAT(6),SSC)
      INTEGER   SYR,SMO,SDY,SHR,SMN,SSC
      EQUIVALENCE (EDAT(1),EYR),(EDAT(2),EMO),(EDAT(3),EDY),
     #            (EDAT(4),EHR),(EDAT(5),EMN),(EDAT(6),ESC)
      INTEGER   EYR,EMO,EDY,EHR,EMN,ESC
C
C
C     + + + EXTERNALS + + +
      EXTERNAL  TIMCNV, COPYI
C
C     + + + END SPECIFICATIONS + + +
C
CJLK  CALL DCALCT(3)
C     make a copy of the dates
      LEN = 6
      CALL COPYI(LEN,DATE1,
     O           SDAT)
      CALL COPYI(LEN,DATE2,
     O           EDAT)
C     convert dates to old format
      CALL TIMCNV (SDAT)
      CALL TIMCNV (EDAT)
C
C     ***************************
C     how about trying this??? jlk 9/95 - 35% slower in wdtget test
C     CALL CKDATE (EDAT,SDAT,I)
C     instead of the rest of this wonderful code
C     ***************************
C
C     check years
      IF (SYR .LT. EYR) THEN
        I= 1
      ELSE IF (SYR .GT. EYR) THEN
        I= -1
      ELSE IF (SMO .LT. EMO) THEN
C     checking months
        I= 1
      ELSE IF (SMO .GT. EMO) THEN
        I= -1
      ELSE IF (SDY .LT. EDY) THEN
C     checking days
        I= 1
      ELSE IF (SDY .GT. EDY) THEN
        I= -1
      ELSE IF (SHR .LT. EHR) THEN
C     checking hours
        I= 1
      ELSE IF (SHR .GT. EHR) THEN
        I= -1
      ELSE IF (SMN .LT. EMN) THEN
C     checking minutes
        I= 1
      ELSE IF (SMN .GT. EMN) THEN
        I= -1
      ELSE IF (SSC .LT. ESC) THEN
C     checking seconds
        I= 1
      ELSE IF (SSC .GT. ESC) THEN
        I= -1
      ELSE
        I= 0
      END IF
C
      TIMCHK= I
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMCNV
     M                    (DATE)
C
C     + + + PURPOSE + + +
C     Convert a date that uses the midnight convention of 00:00
C     to the convention 24:00.  For example, 1982/10/01 00:00:00
C     would be converted to the date 1982/09/30 24:00:00.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE   - date being converted
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL  DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
      IF (DATE(4).EQ.0) THEN
        IF (DATE(5).EQ.0 .AND. DATE(6).EQ.0) THEN
C         date using new day boundry convention, convert to old
          DATE(4)= 24
          DATE(3)= DATE(3)- 1
          IF (DATE(3).EQ.0) THEN
            DATE(2)= DATE(2)- 1
            IF (DATE(2).EQ.0) THEN
              DATE(1)= DATE(1)- 1
              DATE(2)= 12
            END IF
            DATE(3)= DAYMON(DATE(1),DATE(2))
          END IF
        END IF
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMCVT
     M                   (DATE)
C
C     + + + PURPOSE + + +
C     Convert a date that uses the midnight convention of 24:00
C     to the convention 00:00.  For example, 1982/09/30 24:00:00
C     would be converted to the date 1982/10/01 00:00:00.
C
C     + + + HISTORY + + +
C     jlk  00/04/13  check hour 24 but now ignore value for
C                    minute and second.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE   - date being converted
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL  DAYMON
C
C     + + + END SPECIFICATIONS + + +
C
Cjlk  IF (DATE(4).EQ.24 .AND. DATE(5).EQ.0 .AND. DATE(6).EQ.0) THEN
      IF (DATE(4).EQ.24) THEN
C       old midnight convention, convert to new
        DATE(4) = 0
        DATE(3) = DATE(3) + 1
        IF (DATE(3) .GT. DAYMON(DATE(1),DATE(2))) THEN
C         month boundry
          DATE(3) = 1
          DATE(2) = DATE(2) + 1
          IF (DATE(2) .GT. 12) THEN
C           year boundry
            DATE(2) = 1
            DATE(1) = DATE(1) + 1
          END IF
        END IF
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMDIF
     I                    (DATE1,DATE2,TCODE,TSTEP,
     O                     NVALS)
C
C     + + + PURPOSE + + +
C     Calculate the number of time steps between two dates.  Part
C     intervals at a time step less than TCODE and TSSTEP are not
C     included.  If the second date is before the first date, or the
C     second date is the same as the first date, the number of time
C     steps will be returned as 0.  Dates are assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6),DATE2(6),TCODE,TSTEP,NVALS
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - first (starting) date
C     DATE2  - second (ending) date
C     TCODE  - time units code
C              1 - seconds     5 - months
C              2 - minutes     6 - years
C              3 - hours       7 - centuries
C              4 - days
C     TSTEP  - time step in TCODE units
C     NVALS  - number of time steps between DATE1 and DATE2
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   NDAYS,DONFG,NADJ,TMPSTR(6),TMPEND(6),LEN
C
C     + + + FUNCTIONS + + +
      INTEGER   DAYMON, TIMCHK
C
C     + + + EXTERNALS + + +
      EXTERNAL  DAYMON, TIMCNV, COPYI, TIMADD, TIMCHK
C
C     + + + END SPECIFICATIONS + + +
C
CJLK  CALL DCALCT(2)
      IF (TIMCHK(DATE1,DATE2) .EQ. 1) THEN
C       end date follows start date, make temp copies of dates
        LEN = 6
        CALL COPYI (LEN,DATE1,TMPSTR)
        CALL COPYI (LEN,DATE2,TMPEND)
C
C       convert dates to old format
        CALL TIMCNV (TMPSTR)
        CALL TIMCNV (TMPEND)
C
        GO TO (5,5,5,5,50,60,70), TCODE
 5      CONTINUE
C         figure out how many days
          DONFG= 0
          NDAYS= -TMPSTR(3)
 8        CONTINUE
            IF (TMPSTR(1).LT.TMPEND(1).OR.
     1        (TMPSTR(1).EQ.TMPEND(1).AND.TMPSTR(2).LT.TMPEND(2))) THEN
              NDAYS= NDAYS+ DAYMON(TMPSTR(1),TMPSTR(2))
              TMPSTR(2)= TMPSTR(2)+ 1
              IF (TMPSTR(2).EQ.13) THEN
                TMPSTR(2)= 1
                TMPSTR(1)= TMPSTR(1)+ 1
              END IF
            ELSE
              DONFG= 1
            END IF
          IF (DONFG.EQ.0) GO TO 8
          NDAYS= NDAYS+ TMPEND(3)
C
          IF (TCODE .EQ. 1) THEN
C           seconds
            NVALS= ((((NDAYS*24)+
     1               TMPEND(4)-TMPSTR(4))* 60+
     2              TMPEND(5)-TMPSTR(5))* 60+
     3             TMPEND(6)-TMPSTR(6))/ TSTEP
          ELSE IF (TCODE .EQ. 2) THEN
C           minutes
            NVALS= (((NDAYS*24)+
     1              TMPEND(4)-TMPSTR(4))* 60+
     2             TMPEND(5)-TMPSTR(5))/ TSTEP
          ELSE IF (TCODE .EQ. 3) THEN
C           hours
            NVALS= ((NDAYS*24)+
     1             TMPEND(4)- TMPSTR(4))/ TSTEP
          ELSE IF (TCODE .EQ. 4) THEN
C           days
            NVALS= NDAYS/ TSTEP
          END IF
          GO TO 90
C
 50     CONTINUE
C         months
          NVALS= ((TMPEND(1)-TMPSTR(1))*12+TMPEND(2)-TMPSTR(2))/TSTEP
          GO TO 90
C
 60     CONTINUE
C         years
          NVALS= (TMPEND(1)-TMPSTR(1))/ TSTEP
          GO TO 90
C
 70     CONTINUE
C         centuries
          NVALS= (TMPEND(1)-TMPSTR(1))/(TSTEP*100)
          GO TO 90
C
 90     CONTINUE
C
        DONFG= 0
100     CONTINUE
          CALL TIMADD (DATE1,TCODE,TSTEP,NVALS,
     O                 TMPEND)
          NADJ= TIMCHK(DATE2,TMPEND)
          IF (NADJ.EQ.1.AND.NVALS.GE.1) THEN
C           estimate too high
            NVALS= NVALS- 1
          ELSE
C           estimate ok
            DONFG= 1
          END IF
        IF (DONFG.EQ.0) GO TO 100
      ELSE
C       end date is the same as or before start date
        NVALS = 0
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   TIMDFX
     I                    (DATE1,DATE2,
     O                     NVALS,TCODE,TSTEP)
C
C     + + + PURPOSE + + +
C     Calculate the number of values between two dates, including
C     units and time step.  First tries at one year time step, then
C     TCODE is decreased by one and tried again until the exact
C     time difference is determined.  Dates are assumed to be valid.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATE1(6),DATE2(6),TCODE,TSTEP
      INTEGER(4)NVALS
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATE1  - first (starting) date
C     DATE2  - second (ending) date
C     NVALS  - number of values at the output TSTEP and TCODE
C     TCODE  - time units code
C              1 - seconds     5 - months
C              2 - minutes     6 - years
C              3 - hours       7 - centuries
C              4 - days
C     TSTEP  - time step in TCODE units
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   DONFG,TIMTMP(6)
C
C     + + + FUNCTIONS + + +
      INTEGER   TIMCHK
C
C     + + + EXTERNALS + + +
      EXTERNAL   TIMADD, TIMCHK, TIMDIF
C
C     + + + END SPECIFICATIONS + + +
C
      TCODE= 6
      TSTEP= 1
      DONFG= 0
C
 10   CONTINUE
        CALL TIMDIF (DATE1,DATE2,TCODE,TSTEP,
     O               NVALS)
        CALL TIMADD (DATE1,TCODE,TSTEP,NVALS,
     O               TIMTMP)
        IF (TIMCHK(DATE2,TIMTMP).EQ.0) THEN
C         we have call exact units, etc
          DONFG= 1
        ELSE
C         try again with shorter units
          TCODE= TCODE- 1
Cy2k      IF (TCODE.EQ.0) WRITE (*,*) 'BAD TIMDFX',DATE1,DATE2
          IF (TCODE.EQ.0) THEN
C           problem with dates
            WRITE (*,*) 'BAD TIMDFX',DATE1,DATE2
            DONFG = 1
          END IF
        END IF
C
      IF (DONFG.EQ.0) GO TO 10
C
      RETURN
      END
C
C
C
      SUBROUTINE   DTMCMN
     I                   ( NDAT, STRT, STOP, TSTEP, TCODE,
     O                     SDAT, EDAT, TS, TC, RETCOD )
C
C     + + + PURPOSE + + +
C     Determine the time period common to a number of pairs of dates.
C     Determine the smallest common time step and unit.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   NDAT, STRT(6,NDAT), STOP(6,NDAT), TSTEP(NDAT),
     $          TCODE(NDAT), SDAT(6), EDAT(6), TS, TC,
     $          RETCOD
C
C     + + + ARGUMENT DEFINITIONS + + +
C     NDAT   - number of pairs of dates
C     STRT   - array of beginning dates
C     STOP   - array of ending dates
C     TSTEP  - array of time steps
C     TCODE  - array of time units codes
C              1 - second        4 - day
C              2 - minute        5 - month
C              3 - hour          6 - year
C     SDAT   - common starting date
C     EDAT   - common ending date
C     TS     - smallest common time step
C     TC     - smallest common time units
C              1 - second        4 - day
C              2 - minute        5 - month
C              3 - hour          6 - year
C     RETCOD - return code
C               0 - there is a common time period and time step and units
C              -1 - there is no common time period
C              -2 - there is a common time period, but the time step and
C                    time units are not compatible
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   RETC, N, TSTEPF, TCDCMP, LN
C
C     + + + LOCAL DEFINITIONS + + +
C     TSTEPF - time step compatibility flag
C              0 - compatible time steps
C              1 - incompatible time steps
C     TCDCMP - flag indicating order of time steps
C               0 - time steps are the same
C               1 - first time step is smaller
C               2 - second time step is smaller
C              -1 - time units span day-month boundry
C
C     + + + EXTERNALS + + +
      EXTERNAL  DATCMN, CMPTIM, ZIPI
C
C     + + + END SPECIFICATIONS + + +
C
      RETC = 0
C     get common time period
      CALL DATCMN ( NDAT, STRT, STOP, SDAT, EDAT, RETC )
      IF (RETC .EQ. 0) THEN
C       get common time step and units
        TS = TSTEP(1)
        TC = TCODE(1)
        IF (NDAT.GT.1) THEN
C         check others
          N  = 1
 100      CONTINUE
C           look for smallest common time step and unit
            N = N + 1
            CALL CMPTIM ( TCODE(N), TSTEP(N), TC, TS, TSTEPF, TCDCMP )
            IF (TSTEPF .EQ. 0  .AND.  TCDCMP .NE. -1) THEN
C             compatible time steps, do not span day-month boundry
              IF (TCDCMP .EQ. 2) THEN
C               new larger time step
                TS = TSTEP(N)
                TC = TCODE(N)
              END IF
            ELSE
C             incompatible time steps or time units span day-month boundry
              RETC = -2
            END IF
          IF (N .LT. NDAT  .AND.  RETC .EQ. 0) GO TO 100
          IF (RETC .EQ. -2) THEN
C           time step and time units are not all compatible
            TS = 0
            TC = 0
          END IF
        END IF
      ELSE
C       no common time period
        RETC = -1
        LN = 6
        N  = 0
        CALL ZIPI ( LN, N, SDAT )
        CALL ZIPI ( LN, N, EDAT )
        TS = 0
        TC = 0
      END IF
      RETCOD = RETC
C
      RETURN
      END
C              
C
C
      SUBROUTINE   DATCMN
     I                   ( NDAT, STRT, STOP,
     O                     SDAT, EDAT, RETCOD )
C
C     + + + PURPOSE + + +
C     Determine the time period common to a number of pairs of dates.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   NDAT, STRT(6,NDAT), STOP(6,NDAT), SDAT(6), EDAT(6),
     $          RETCOD
C
C     + + + ARGUMENT DEFINITIONS + + +
C     NDAT   - number of pairs of dates
C     STRT   - array of beginning dates
C     STOP   - array of ending dates
C     SDAT   - common starting data
C     EDAT   - common ending date
C     RETCOD - return code
C               0 - there is a common time period
C              -1 - there is no common time period
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   FSLS, DATE(6,2), RETC, LEN, ZIP
C     INTEGER   I, J
C
C     + + + EXTERNALS + + +
      EXTERNAL  DLIMIT, CKDATE, COPYI, ZIPI
C
C     + + + END SPECIFICATIONS + + +
C
C     write(*,*) 'DATCMN',NDAT
C     DO I= 1,NDAT
C       WRITE(*,*) '  STRT',I,(STRT(J,I),J=1,4)
C     END DO
C     get latest start date
      FSLS = 2
      CALL DLIMIT ( STRT, NDAT, FSLS, DATE(1,1) )
C     WRITE(*,*) '  LAST',FSLS,(DATE(J,1),J=1,4)
C     DO I= 1,NDAT
C       WRITE(*,*) '  STOP',I,(STOP(J,I),J=1,4)
C     END DO
C     get earliest end date
      FSLS = 1
      CALL DLIMIT ( STOP, NDAT, FSLS, DATE(1,2) )
C     WRITE(*,*) '  FRST',FSLS,(DATE(J,2),J=1,4)
C     is start data before end date?
      CALL CKDATE ( DATE(1,1), DATE(1,2), RETC )
      IF (RETC .EQ. -1) THEN
C       common start date before common end date, as hoped for
        LEN = 6
        CALL COPYI ( LEN, DATE(1,1), SDAT )
        CALL COPYI ( LEN, DATE(1,2), EDAT )
        RETCOD = 0
      ELSE
C       begin and end the same (0) or common start after common end (1)
        LEN = 6
        ZIP = 0
        CALL ZIPI ( LEN, ZIP, SDAT )
        CALL ZIPI ( LEN, ZIP, EDAT )
        RETCOD = -1
      END IF
C     WRITE(*,*) '  CHCK',RETC,RETCOD
C
      RETURN
      END
C
C
C
      SUBROUTINE   GTMONC
     I                   ( INDX, LEN, LORU,
     M                     LENO, MONTH )
C
C     + + + PURPOSE + + +
C     Given the number of the month and a length, returns the
C     character string for that month.
C     For LEN >= 9, the full month is returned.
C     For LEN  = 3, the standard 3-character abbreviation is returned.
C     For LEN  = 1, the first character of the month is returned
C     For LEN  = 2, the first 2 characters of the standard 3-character
C                   abbreviation are returned
C     For LEN < 9 & > 4, the first LEN characters of the full month
C                   are returned.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER     INDX, LEN, LORU, LENO
      CHARACTER(1)MONTH(LEN)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     INDX   - index number of the month (1-jan,2-feb,...,12-dec)
C     LEN    - available length for month
C     LORU   - flag for case
C              1 - first letter upper case, remaining letters lower case
C              2 - all letters upper case
C     LENO   - actual characters in month
C              returns 0 if indx not a valid month or len < 1
C     MONTH  - character string of lenght LEN containing name of month
C
C     + + + LOCAL VARIABLES + + +
      INTEGER      NOC(12), CASE, I, LENL
      CHARACTER(3) MOS(12,2)
      CHARACTER(9) MOL(12,2)
C
C     + + + DATA INITIALIZATIONS + + +
      DATA  MOS / 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
     $            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec',
     $            'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
     $            'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /
      DATA  MOL / 'January  ', 'February ', 'March    ', 'April    ',
     $            'May      ', 'June     ', 'July     ', 'August   ',
     $            'September', 'October  ', 'November ', 'December ',
     $            'JANUARY  ', 'FEBRUARY ', 'MARCH    ', 'APRIL    ',
     $            'MAY      ', 'JUNE     ', 'JULY     ', 'AUGUST   ',
     $            'SEPTEMBER', 'OCTOBER  ', 'NOVEMBER ', 'DECEMBER ' /
      DATA  NOC /  7,           8,           5,           5,
     $             3,           4,           4,           6,
     $             9,           7,           8,           8 /
C
C     + + + INPUT FORMATS + + +
 1000 FORMAT ( 9A1 )
C
C     + + + END SPECIFICATIONS + + +
C
      IF (LORU .EQ. 1  .OR.  LORU .EQ. 2) THEN
C       valid case flag
        CASE = LORU
      ELSE
C       invalid case flag, default to mixed case
        CASE = 1
      END IF
C
      IF (INDX .LT. 1  .OR.  INDX .GT. 12) THEN
C       invalid month
        LENO = 0
      ELSE IF (LEN .LT. 1) THEN
C       invalid length, return nothing
        LENO = 0
      ELSE IF (LEN .GE. 1  .AND.  LEN .LE. 3) THEN
C       return short month
        READ (MOS(INDX,CASE),1000) (MONTH(I), I = 1, LEN)
        LENO = LEN
      ELSE IF (LEN .GE. 9) THEN
C       return full month
        LENL = 9
        READ (MOL(INDX,CASE),1000) (MONTH(I), I = 1, LENL)
        LENO = NOC(INDX)
      ELSE
C       return as much of full month as allowed
        READ (MOL(INDX,CASE),1000) (MONTH(I), I = 1, LEN)
        IF (LEN .LT. NOC(INDX)) THEN
C         not enough room for full length
          LENO = LEN
        ELSE
C         month fit
          LENO = NOC(INDX)
        END IF
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   DHLEAP
     I                   ( DATBGN, STMO, EDMO,
     O                     LPDAY, LPYRS )
C
C     + + + PURPOSE + + +
C     Given a starting date and the season begin and end months,
C     determine where leap day occurs in the series and determine
C     when the the first leap year occurs.  Assumptions: (1) datbgn
C     is a valid date and (2) the STMO and EDMO months define a season
C     equal to or shorter than a full year.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATBGN(6), STMO, EDMO, LPDAY, LPYRS
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATBGN - beginning date
C     STMO   - beginning month of season
C     EDMO   - ending month of season
C     LPDAY  - postion in season where leap day occurs,
C              returns 0 if leap day not contained in season
C     LPYRS  - offset to first leap year in time series
C              0 - current season contains leap day
C              1 - second season in series will contain leap day
C              2 - third season in series will contain leap day
C              3 - fourth season in series will contain leap day
C
C     + + + LOCAL VARIALBES + + +
      INTEGER   DATLEP(6), TUNITS, TSSTEP
C
C     + + + FUNCTIONS + + +
      INTEGER     DHLPYR
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + EXTERNALS + + +
      EXTERNAL   TIMDIF, DHLPYR
C
C     + + + DATA INITIALIZATIONS + + +
      DATA  DATLEP / 0,2,28,24,0,0 /
C
C     + + + END SPECIFICATIONS + + +
C
      TUNITS = 4
      TSSTEP = 1
C
      IF ((STMO .EQ. 2  .OR.   EDMO .EQ. 2)  .OR.
     $    (STMO .GT. 2  .AND.  EDMO .GE. 2  .AND.  STMO .GT. EDMO)  .OR.
     $    (STMO .EQ. 1  .AND.  EDMO .GE. 2)) THEN
C       February is included in season, which positon is leap day
        IF (STMO .LE. 2) THEN
C         February in starting year of season
          DATLEP(1) = DATBGN(1)
Cy2k      LPYRS = MOD ( DATBGN(1), 4 )
          LPYRS = DHLPYR ( DATBGN(1) )
        ELSE
C         February in second year of season
          DATLEP(1) = DATBGN(1) + 1
Cy2k      LPYRS = MOD ( DATBGN(1)+1, 4 )
          LPYRS = DHLPYR ( DATBGN(1)+1 )
        END IF
C       find Feb 28 and increment by 1 to the 29th
        CALL TIMDIF ( DATBGN, DATLEP, TUNITS, TSSTEP, LPDAY )
        LPDAY = LPDAY + 1
      ELSE
C       February is not included in season
        LPDAY = 0
Cy2k    LPYRS = MOD ( DATBGN(1), 4 )
        LPYRS = DHLPYR ( DATBGN(1) )
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   DHBEGN
     I                   ( DATBGN, DATEND, STMO, EDMO,
     O                     SEASON, SEASBG, SEASND, IPT )
C
C     + + + PURPOSE + + +
C     Given a period of record and the beginning and ending months of
C     the season to be analyzed, determine the start and end dates
C     of the first season.  Assumptions:  (1) the dates input
C     are valid, (2) the STMO and EDMO months define a season
C     equal to or shorter than a full year, (3) full months are
C     used, and (4) the first season will end at the end of the season.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   DATBGN(6), DATEND(6), STMO, EDMO,
     $          SEASON(12), SEASBG(6), SEASND(6), IPT
C
C     + + + ARGUMENT DEFINITIONS + + +
C     DATBGN - beginning date of time series
C     DATEND - ending date of time series
C     STMO   - beginning month of season
C     EDMO   - ending month of season
C     SEASON - available begin date and end date for first season
C     SEASBG - start date for first season
C     SEASND - start date for last season
C     IPT    - pointer to position in time series for first data
C              value in first season
C
C     + + + LOCAL VARIABLES + + +
      INTEGER    TUNITS, TSSTEP, I6
C
C     + + + FUNCTIONS + + +
      INTEGER    DAYMON
C
C     + + + EXTERNALS + + +
      EXTERNAL   DAYMON, TIMDIF, COPYI
C
C     + + + END SPECIFICATIONS + + +
C
      TUNITS = 4
      TSSTEP = 1
      I6     = 6
C
      CALL COPYI ( I6, DATBGN, SEASON )
      SEASON(8)  = EDMO
      SEASON(10) = 24
      SEASON(11) = 0
      SEASON(12) = 0
      SEASBG(2)  = STMO
      SEASBG(3)  = 1
      SEASBG(4)  = 0
      SEASBG(5)  = 0
      SEASBG(6)  = 0
      SEASND(2)  = STMO
      SEASND(3)  = 1
      SEASND(4)  = 0
      SEASND(5)  = 0
      SEASND(6)  = 0
      IF (STMO .LE. EDMO) THEN
C       season begins and ends in same calendar year
        IF (DATBGN(2) .LE. EDMO) THEN
C         start date begins before end of season
          SEASON(7) = DATBGN(1)
          SEASBG(1) = DATBGN(1)
        ELSE
C         start date begins after end of season, next year
          SEASON(1) = DATBGN(1) + 1
          SEASON(2) = STMO
          SEASON(7) = DATBGN(1) + 1
          SEASBG(1) = DATBGN(1) + 1
        END IF
        IF (DATEND(2) .GE. STMO) THEN
C         end date ends after end of season
          SEASND(1) = DATEND(1)
        ELSE
C         end date ends before beginning of season, previous year
          SEASND(1) = DATEND(1) - 1
        END IF
      ELSE
C       season spans calendar years
        IF (DATBGN(2) .GE. STMO) THEN
C         start date begins before Jan 1, season ends in next year
          SEASON(7) = DATBGN(1) + 1
          SEASBG(1) = DATBGN(1)
        ELSE
C         start date begins after Jan 1, season ends in same year
          SEASON(7) = DATBGN(1)
          SEASBG(1) = DATBGN(1) - 1
        END IF
        IF (DATEND(2) .LE. EDMO) THEN
C         end date is after Jan 1, last season begins in previous year
          SEASND(1) = DATEND(1) - 1
        ELSE
C         end date is before Jan 1, last season begins in same year
          SEASND(1) = DATEND(1)
        END IF
      END IF
      SEASON(9) = DAYMON ( SEASON(7), SEASON(8) )
C
C     where in season does data begin
      CALL TIMDIF ( SEASBG, SEASON, TUNITS, TSSTEP, IPT )
      IPT = IPT + 1
C
      RETURN
      END
C
C
C
      SUBROUTINE   DHINCR
     I                   ( SEASBG, SEASND, DATBGN, DATEND,
     M                     SEASON, MORE )
C
C     + + + PURPOSE + + +
C     Increment begin and end dates to next season.  Assumes that a
C     season is one year or shorter in length.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   SEASBG(6), SEASND(6), DATBGN(6), DATEND(6),
     $          SEASON(12), MORE
C
C     + + + ARGUMENT DEFINITIONS + + +
C     SEASBG - start date for first season
C     SEASND - start date for last season
C     DATBGN - beginning date of time series
C     DATEND - ending date of time series
C     SEASON - input as previous time period, incremented to next
C     MORE   - indicator for time period
C              -1 - new time period defined
C               0 - already at end of time period
C
C     + + + END SPECIFICATIONS + + +
C
      IF (SEASON(1) .EQ. DATBGN(1)  .AND.
     $    SEASON(2) .EQ. DATBGN(2)) THEN
C       first season may not have been full, make sure next is
        SEASON(1) = SEASBG(1)
        SEASON(2) = SEASBG(2)
        SEASON(3) = 1
      END IF
C
      IF (SEASON(1) .EQ. SEASND(1)  .AND.
     $    SEASON(2) .EQ. SEASND(2)) THEN
C       have reached end of time period, done
        MORE = 0
      ELSE
C       not at end, increment dates
        MORE = -1
        SEASON(1) = SEASON(1) + 1
        IF (SEASON(1) .EQ. SEASND(1)  .AND.
     $      SEASON(2) .EQ. SEASND(2)) THEN
C         last season may not be full year
          SEASON(7) = DATEND(1)
          SEASON(8) = DATEND(2)
          SEASON(9) = DATEND(3)
        ELSE
C         increment end year
          SEASON(7) = SEASON(7) + 1
        END IF
      END IF
C
      RETURN
      END
C
C
C
      SUBROUTINE   DBNDRY
     I                    ( FWDBAK,
     M                      DATE )
C
C     + + + PURPOSE + + +
C     Force a date to a day boundary
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   FWDBAK, DATE(6)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     FWDBAK - indicator flag for action to be taken is not day boundary
C              1 - move forward to next day
C              2 - move back to previous day
C     DATE   - date (year,month,day,hour,minute,second)
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   TCODE, TSTEP, NVAL, DATE2(6), LEN6
C
C     + + + EXTERNALS + + +
      EXTERNAL   TIMADD, TIMBAK, COPYI
C
C     + + + DATA INITIALIZATIONS + + +
      DATA  TCODE, TSTEP, NVAL, LEN6
     $     /    4,     1,    1,    6 /
C
C     + + + END SPECIFICATIONS + + +
C
      IF (FWDBAK .EQ. 1  .AND.
     $   (DATE(4) .NE. 0 .OR. DATE(5) .NE. 0 .OR. DATE(6) .NE. 0)) THEN
C       start date does not begin at 00:00:00
        DATE(4) = 0
        DATE(5) = 0
        DATE(6) = 0
        CALL TIMADD ( DATE, TCODE, TSTEP, NVAL,
     O                DATE2 )
        CALL COPYI ( LEN6, DATE2, DATE )
      ELSE IF (FWDBAK .EQ. 2  .AND.
     $  (DATE(4) .NE. 24 .OR. DATE(5) .NE. 0 .OR. DATE(6) .NE. 0)) THEN
        DATE(4) = 24
        DATE(5) = 0
        DATE(6) = 0
        CALL TIMBAK ( TCODE, DATE )
      END IF
C       
      RETURN
      END
C
C
C
      SUBROUTINE   DCALCT
     I                   (IND)
C
C     + + + PURPOSE + + +
C     count calls to selected date routines
C
C     + + + DUMMY ARGUEMENTS + + +
      INTEGER   IND
C
C     + + + ARGUMENT DEFINITIONS + + +
C     IND    - index of counter to incremnt, <0:other
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   CNT(5)
      SAVE      CNT
C
C     + + + OUTPUT FORMATS + + +
 2000 FORMAT (20I8)
C
C     + + + END SPECIFICATIONS + + +
C
      IF (IND .GT. 0) THEN
        CNT(IND)= CNT(IND)+ 1
      ELSE IF (IND .EQ. 0) THEN
        CNT(1) = 0
        CNT(2) = 0
        CNT(3) = 0
        CNT(4) = 0
        CNT(5) = 0
      ELSE IF (IND .EQ. -1) THEN
        WRITE(98,2000) CNT
        CNT(1) = 0
        CNT(2) = 0
        CNT(3) = 0
        CNT(4) = 0
        CNT(5) = 0
      END IF
C
      RETURN
      END
C
C
C
      INTEGER   FUNCTION   DHLPYR
     I                            ( YEAR )
C
C     + + + PURPOSE + + +
C     Determine if year provided is a leap year.  A 2-digit
C     year is assumed to be in the first century and not just
C     an abbreviation for the current century.  Recognizes
C     400-century as leap year.
C     DHLPYR = 0 - when year is a leap year
C              1 - when year is 1 year past leap year
C              2 - when year is 2 years past leap year
C              3 - when year is 3 years past leap year
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   YEAR
C
C     + + + ARGUMENT DEFININTIONS + + +
C     YEAR   - calendar year
C
C     + + + LOCAL VARIABLES + + +
      INTEGER   LEAP
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD
C
C     + + + END SPECIFICATIONS + + +
C
      IF (MOD(YEAR,4) .EQ. 0  .AND.
     $   (MOD(YEAR,100).NE.0  .OR.  MOD(YEAR,400).EQ. 0)) THEN
C       leap year
        LEAP = 0
      ELSE IF (MOD(YEAR+1,4) .EQ. 0  .AND.
     $   (MOD(YEAR+1,100).NE.0  .OR.  MOD(YEAR+1,400).EQ. 0)) THEN
C       leap year is the next year
        LEAP = 1
      ELSE IF (MOD(YEAR+2,4) .EQ. 0  .AND.
     $   (MOD(YEAR+2,100).NE.0  .OR.  MOD(YEAR+2,400).EQ. 0)) THEN
C       leap year is two years later
        LEAP = 2
      ELSE IF (MOD(YEAR+3,4) .EQ. 0  .AND.
     $   (MOD(YEAR+3,100).NE.0  .OR.  MOD(YEAR+3,400).EQ. 0)) THEN
C       leap year is three years later
        LEAP = 3
      END IF
C
      DHLPYR = LEAP
C
      RETURN
      END
C
C
C
      SUBROUTINE   SBNDRY
     I                   ( FWDBAK, MON, DAY,
     M                     DATE )
C
C     + + + PURPOSE + + +
C     Force a date to a season boundary.  Does not consider
C     hour, minute, or second.
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER   FWDBAK, MON, DAY, DATE(3)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     FWDBAK - indicator flag for action to be taken
C              1 - move forward to start of season
C              2 - move back to end of season
C     MON    - month season begins (fwdbak=1) or ends (fwdbak=2)
C     DAY    - day season begins (fwdbak=1) or ends (fwdbak=2)
C     DATE   - date (year,month,day)
C
C     + + + END SPECIFICATIONS + + +
C
      IF (FWDBAK .EQ. 1) THEN
C       force date to start at season boundary
        IF (DATE(2) .GT. MON) THEN
C         date is after start of season, advance to next year
          DATE(1) = DATE(1) + 1
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(2) .LT. MON) THEN
C         date month is before start of season, advance to season
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(3) .GT. DAY) THEN
C         month ok, but day after requested start, advance next year
          DATE(1) = DATE(1) + 1
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(3) .LT. DAY) THEN
C         start day is before start of season, advance to season
          DATE(3) = DAY
        END IF
      ELSE IF (FWDBAK .EQ. 2) THEN
C       force date to end at season boundary
        IF (DATE(2) .LT. MON) THEN
C         date is before end of season, fall back a year
          DATE(1) = DATE(1) - 1
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(2) .GT. MON) THEN
C         date month is after end of season, fall back to season
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(3) .LT. DAY) THEN
C         month ok, but day is before requested end, fall back a year
          DATE(1) = DATE(1) - 1
          DATE(2) = MON
          DATE(3) = DAY
        ELSE IF (DATE(3) .GT. DAY) THEN
C         end day is after end of season, fall back to season
          DATE(3) = DAY
        END IF
      END IF
C
      RETURN
      END
