
MODULE MyKinds
  INTEGER, PARAMETER :: INTEGER1 = SELECTED_INT_KIND(R=1)           ! 1-byte
  INTEGER, PARAMETER :: INTEGER2 = SELECTED_INT_KIND(R=4)           ! 2-byte
  INTEGER, PARAMETER :: INTEGER4 = SELECTED_INT_KIND(R=8)           ! 4-byte
  INTEGER, PARAMETER :: INTEGER8 = SELECTED_INT_KIND(R=12)          ! 8-byte
  INTEGER, PARAMETER :: REAL4    = SELECTED_REAL_KIND(P=6,R=37)     ! 4-byte
  INTEGER, PARAMETER :: REAL8    = SELECTED_REAL_KIND(P=15,R=100)   ! 8-byte
END MODULE MyKinds

MODULE GLERLUTIL
  USE MyKinds
  USE ErrorProcess
  
  INTEGER, PARAMETER :: MissingData_Int       = -2147000000    ! nearly max negative
  REAL,    PARAMETER :: MissingData_Real      = -9.9e29
  REAL,    PARAMETER :: MissingData_Real_Test = -9.0e29
  
!
! This is a list of the open files (unit numbers) at any given time in
! the program execution.  An entry of -1 indicates the end of the list.
! It's used to ensure that all files are closed whenever we exit this
! program for any reason.  It is especially useful if a CANCEL condition
! is encountered.  The CANCEL condition is initiated by the Windows GUI
! and results in the existence of a file called CANCEL.INT.  The program
! can periodically test for the existence of that file and exit gracefully
! if it is there.
!
  INTEGER              :: OpenedFiles = 0
  INTEGER, PARAMETER   :: MaxOpenedFiles = 60
  INTEGER, DIMENSION(MaxOpenedFiles)  :: OpenedFileUnits

!
!  Define the OS-specific file path separator character
!
#if defined(LINUX)
     CHARACTER(LEN=1), PARAMETER :: FilePathSeparator = '/'
#else
     CHARACTER(LEN=1), PARAMETER :: FilePathSeparator = '\'
#endif
  
!
! Define a flag value for missing dates from DateSequence/SequenceDate
!
  INTEGER, PARAMETER :: DateSeq_MissingDate = -999999
  
!
! This is the definition of a quarter-month based on the
! definitions received from USACE - Buffalo.
! The values in each array are the end day of the qtr-months when
! the month has the specified number of days.  i.e. when the month
! has 30 days then the quarter-months end on days 8, 15, 23, 30.
!
  INTEGER, PARAMETER, DIMENSION(4) :: Q28 = (/7, 14, 21, 28/)
  INTEGER, PARAMETER, DIMENSION(4) :: Q29 = (/7, 14, 21, 29/)
  INTEGER, PARAMETER, DIMENSION(4) :: Q30 = (/8, 15, 23, 30/)
  INTEGER, PARAMETER, DIMENSION(4) :: Q31 = (/8, 15, 23, 31/)


  CHARACTER(LEN=1), PARAMETER, DIMENSION(12) :: MonCode1 =               &
                  (/'J','F','M','A','M','J','J','A','S','O','N','D'/)

  CHARACTER(LEN=3), PARAMETER, DIMENSION(12) :: MonCode3 =               &
           (/'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',                   &
             'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/)


             
!-------------------------------------------------------------------------
 
   PUBLIC :: DayOfYear
   PRIVATE :: DayOfYearFromSeq, DayOfYearFromDMY

   INTERFACE DayOfYear
      MODULE PROCEDURE DayOfYearFromSeq, DayOfYearFromDMY
   END INTERFACE DayOfYear

   PUBLIC :: FirstDayOfQtrMon
   PRIVATE :: StartOfQtr1, StartOfQtr2, StartOfQtr3
   INTERFACE FirstDayOfQtrMon
      MODULE PROCEDURE StartOfQtr1, StartOfQtr2, StartOfQtr3
   END INTERFACE FirstDayOfQtrMon

   PUBLIC :: LastDayOfQtrMon
   PRIVATE :: EndOfQtr1, EndOfQtr2, EndOfQtr3
   INTERFACE LastDayOfQtrMon
      MODULE PROCEDURE EndOfQtr1, EndOfQtr2, EndOfQtr3
   END INTERFACE LastDayOfQtrMon

!--------------------------------------------------------------------------


CONTAINS
!--------------------------------------------------------------------------
      SUBROUTINE ParseCfgLine(Line, Item, Value)
      IMPLICIT NONE
      CHARACTER (LEN=*), INTENT(INOUT) :: Line, Item, Value

      INTEGER :: I
      CHARACTER (LEN=150) :: LS, RS

      !
      !  Find the first = sign, if there is one
      !
      I = INDEX(Line, '=')
      IF (I .EQ. 0) THEN
         Item = ''
         Value = ''
         RETURN
      END IF
      !
      !  Split the line into the left and right sides of that = sign
      !
      LS  = Line(1:I-1)
      RS = Line(I+1:LEN_TRIM(Line)) 
      !
      !  Trim leading and trailing blanks from each
      !
      LS = ADJUSTL(LS)
      LS = TRIM(LS)
      RS = ADJUSTL(RS)
      RS = TRIM(RS)
      !
      !  Assign to arguments passed back, ensuring that we don't 
      !  overrun the end of those strings.
      !
      I = LEN(LS)
      IF (I .GT. LEN(Item)) I = LEN(Item)
      Item = LS(1:I)
      I = LEN(RS)
      IF (I .GT. LEN(Value)) I = LEN(Value)
      Value = RS(1:I)
      END SUBROUTINE ParseCfgLine

!--------------------------------------------------------------------------
      SUBROUTINE ParseCmdLine(Line, Args, ArgC)
      IMPLICIT NONE
      CHARACTER (LEN=*), INTENT(IN)  :: Line
      CHARACTER (LEN=*), INTENT(OUT) :: Args(:)
      INTEGER,           INTENT(OUT) :: ArgC

      INTEGER :: UB, TL, CP, LS, RS
      LOGICAL :: Found

      UB = UBOUND(Args,1)
      Args(:) = ''

      !
      !  Total length of the line
      !
      TL = LEN_TRIM(Line)     ! Trimmed Length
      ArgC = 0                ! # of arguments found
      CP = 1                  ! Current Position in Line
      DO WHILE (CP .LE. TL)
         Found = .FALSE.
         DO WHILE (.NOT. Found)
            IF ((Line(CP:CP) .NE. ' ') .OR. (CP .EQ. TL)) Found = .TRUE.
            IF (.NOT. Found) CP = CP +1
         ENDDO
         IF (CP .LE. TL) THEN
            LS = CP                           ! Left Side of argument
            Found = .FALSE.
            DO WHILE (.NOT. Found)
               IF (CP .GE. TL) THEN
                  RS = TL                     ! Right Side of argument
                  Found = .TRUE.
                  CP = TL + 1                 ! Force termination of main loop
               ELSE
                  CP = CP + 1
                  IF (Line(CP:CP) .EQ. ' ') THEN
                     RS = CP - 1              ! Right Side of argument
                     Found = .TRUE.
                  END IF
               END IF
            ENDDO
            ArgC = ArgC + 1
            IF (ArgC .LE. UB) Args(ArgC) = Line(LS:RS)
         ENDIF
      ENDDO
      END SUBROUTINE ParseCmdLine

!------------------------------------------------------------------
      SUBROUTINE ParseCmdLineOneArg(CLine, PNum, Param)
      IMPLICIT   NONE
      INTEGER, INTENT(IN)            :: PNum
      CHARACTER (LEN=*), INTENT(IN)  :: CLine
      CHARACTER (LEN=*), INTENT(OUT) :: Param

      INTEGER  ::  I, J, St, En, Lngth

      Param = ' '
      Lngth = LEN_TRIM(CLine)

!
!  Find the start of parameter number "PNum", if we can
!
      I = 0
      DO J = 1, PNum
        I = I + 1
        DO WHILE ((I .LE. Lngth) .AND. (CLine(I:I) .EQ. ' '))
          I = I + 1
        END DO
        IF (I .GT. Lngth) RETURN
        IF (J .NE. PNum) THEN
          DO WHILE ((I .LT. Lngth) .AND. (CLine(I:I) .NE. ' '))
            I = I + 1
          END DO
        END IF
      END DO
      St = I

!
!  Find the end of that parameter
!
      DO WHILE ((I .LT. Lngth) .AND. (CLine(I:I) .NE. ' '))
         I = I + 1
      END DO
      IF (CLine(I:I) .EQ. ' ') I = I-1      ! back up to the last valid char
      En = I

!
!  Assign value to Param
!
      J = En - St + 1
      Param(1:J) = CLine(St:En) // ' '

      END SUBROUTINE ParseCmdLineOneArg

!--------------------------------------------------------------------------
   SUBROUTINE ParseTabDelimitedLine(Line, Args, ArgC)
   IMPLICIT NONE
   CHARACTER (LEN=*), INTENT(IN)  :: Line
   CHARACTER (LEN=*), INTENT(OUT) :: Args(:)
   INTEGER,           INTENT(OUT) :: ArgC

   INTEGER :: UB, TL, CP, LS, RS
   CHARACTER(LEN=1), PARAMETER :: Tab = CHAR(9)
   CHARACTER(LEN=1), PARAMETER :: Blank = CHAR(32)

   UB = UBOUND(Args,1)

   !
   !  Total length of the line
   !
   TL = LEN_TRIM(Line)     ! Total Length of line
   ArgC = 0                ! # of arguments found
   CP = 1                  ! Current position in Line
   DO WHILE (CP .LE. TL)
      !
      !  Skip any leading blanks
      !
      DO WHILE ((Line(CP:CP) .EQ. Blank) .AND. (CP .LE. TL))
         CP = CP +1
      ENDDO
      
      !
      !  Construct the string
      !
      IF (CP .LE. TL) THEN
         LS = CP        ! Left Side of argument
         RS = CP
         DO WHILE ((Line(CP:CP) .NE. Tab) .AND. (CP .LE. TL))
            RS = CP
            CP = CP + 1
         ENDDO
         ArgC = ArgC + 1
         IF (ArgC .LE. UB) Args(ArgC) = Line(LS:RS)
         CP = CP + 1
         DO WHILE ((Line(CP:CP) .EQ. Blank) .AND. (CP .LE. TL))
            CP = CP +1
         ENDDO
      ENDIF
   ENDDO
   RETURN
   END SUBROUTINE ParseTabDelimitedLine

!--------------------------------------------------------------------------
   SUBROUTINE ParseDelimitedLine(Line, Delimiter, Args, ArgC)
   IMPLICIT NONE
   CHARACTER (LEN=*), INTENT(IN)  :: Line
   CHARACTER (LEN=1), INTENT(IN)  :: Delimiter
   CHARACTER (LEN=*), INTENT(OUT) :: Args(:)
   INTEGER,           INTENT(OUT) :: ArgC

   INTEGER :: UB, TL, CP, LS, RS
   CHARACTER(LEN=1), PARAMETER :: Blank = CHAR(32)

   UB = UBOUND(Args,1)

   !
   !  Total length of the line
   !
   TL = LEN_TRIM(Line)     ! Total Length of line
   ArgC = 0                ! # of arguments found
   CP = 1                  ! Current position in Line
   DO WHILE (CP .LE. TL)
      !
      !  Skip any leading blanks
      !
      DO WHILE ((Line(CP:CP) .EQ. Blank) .AND. (CP .LE. TL))
         CP = CP +1
      ENDDO
      
      !
      !  Construct the string
      !
      IF (CP .LE. TL) THEN
         LS = CP        ! Left Side of argument
         RS = CP
         DO WHILE ((Line(CP:CP) .NE. Delimiter) .AND. (CP .LE. TL))
            RS = CP
            CP = CP + 1
         ENDDO
         ArgC = ArgC + 1
         IF (ArgC .LE. UB) Args(ArgC) = Line(LS:RS)
         CP = CP + 1
         DO WHILE ((Line(CP:CP) .EQ. Blank) .AND. (CP .LE. TL))
            CP = CP +1
         ENDDO
      ENDIF
   ENDDO
   RETURN
   END SUBROUTINE ParseDelimitedLine

!--------------------------------------------------------------------------
   SUBROUTINE ParseCommaSepLine(Line, Strings, StripDoubleQuotes, ValidNum)
   IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: Line
   CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: Strings
   LOGICAL, OPTIONAL, INTENT(IN)  :: StripDoubleQuotes
   INTEGER, OPTIONAL, INTENT(OUT) :: ValidNum

   INTEGER :: MaxStrings, SNum, LineLen, StrLen
   INTEGER :: I, J, K, TokenNum
   LOGICAL :: InToken, KillQuotes
   CHARACTER(LEN=500) :: TStr
   CHARACTER(LEN=500), DIMENSION(:), ALLOCATABLE :: StringTokens
   CHARACTER(LEN=5000) :: TokenizedLine

   IF (PRESENT(ValidNum)) ValidNum = 0
   IF (PRESENT(StripDoubleQuotes)) THEN
      KillQuotes = StripDoubleQuotes
   ELSE
      KillQuotes = .TRUE.    ! default behavior is to remove double quotes
   END IF
   LineLen = LEN_TRIM(Line)
   MaxStrings = SIZE(Strings)
   Strings(:) = ''
   
   ALLOCATE(StringTokens(MaxStrings), STAT=I)
   IF (I .NE. 0) THEN
      ErrorLevel = 1
      RETURN
   END IF
   StringTokens(:) = ''

   !
   !  Fill the Strings() entries with all blanks. One character at a time.
   !  Seems like a messy way to do it, but is necessary, at least with the
   !  fortran compiler I am using.
   !
   StrLen = LEN(Strings(1))     ! max length of each string
   DO I = 1, MaxStrings
      DO J = 1, StrLen
         Strings(I)(J:J) = ' '
      END DO
   END DO
   
   !
   !  Extract string tokens
   !
   TokenizedLine = ''
   TokenNum = 0
   J = 0
   InToken = .FALSE.
   DO WHILE (J .LT. LineLen)
      J = J + 1
      IF (.NOT. InToken) THEN
         IF (Line(J:J) .EQ. CHAR(34)) THEN
            InToken = .TRUE.
            TokenNum = TokenNum + 1
            K = 1
            StringTokens(TokenNum)(K:K) = Line(J:J)           ! opening DblQuote
            TokenizedLine = TRIM(TokenizedLine) // '"'
         ELSE
            TokenizedLine = TRIM(TokenizedLine) // Line(J:J)
         END IF
      ELSE
         K = K + 1
         StringTokens(TokenNum)(K:K) = Line(J:J)
         IF (Line(J:J) .EQ. CHAR(34)) THEN
            InToken = .FALSE.
         END IF
      END IF
   END DO
   
   !
   !  Parse the tokenized line, separating by commas
   !
   SNum = 1
   J = 0
   I = 1
   LineLen = LEN(TokenizedLine)
   DO WHILE ((J .LT. LineLen) .AND. (SNum .LE. MaxStrings))
      J = J + 1
      IF (TokenizedLine(J:J) .EQ. ',') THEN
         IF (I .LT. J) THEN
            K = I + LEN(Strings(SNum)) - 1
            IF (K .GE. J-1) THEN
               Strings(SNum) = TRIM(TokenizedLine(I:J-1))
            ELSE
               Strings(SNum) = TRIM(TokenizedLine(I:K))    ! truncate to fit
            END IF
         ELSE
            Strings(SNum) = ''
         END IF
         SNum = SNum + 1
         I = J+1
      END IF
   END DO
   IF ((J .GE. LineLen) .AND. (SNum .LE. MaxStrings)) THEN
      IF (I .LT. J) THEN
         Strings(SNum) = TRIM(TokenizedLine(I:J))
      ELSE
         Strings(SNum) = ''
      END IF
   END IF   
   
   !
   !  Now replace the DblQuote tokens with their respective string.
   !  If the caller specified TRUE for StripDoubleQuotes, then the leading 
   !  and trailing double quote characters will be removed. If the caller
   !  specified false, then they remain as part of the string and are not removed.
   !
   TokenNum = 0
   DO I = 1, SNum
      IF (Strings(I)(1:1) .EQ. CHAR(34)) THEN
         TokenNum = TokenNum + 1
         IF (KillQuotes) THEN
            TStr = TRIM(StringTokens(TokenNum))
            J = LEN_TRIM(TStr)
            Strings(I) = TStr(2:J-1)
         ELSE
            Strings(I) = TRIM(StringTokens(TokenNum))
         END IF
      END IF
   END DO

   IF (PRESENT(ValidNum)) ValidNum = SNum
   DEALLOCATE(StringTokens, STAT=I)
   
   END SUBROUTINE ParseCommaSepLine
   
!-------------------------------------------------------------
!  This routine will process the Path and FName variables, passing
!  back the correct values in FP (path) and FN (name).
!
!  1) If FName contains both a path and file name then they will be
!     split apart and assigned to FP and FN
!
!  2) If Path contains anything then it will be formatted into a
!     good path specification (adding a "\" at the end if needed) so
!     that it can be prepended to FN yielding a valid file name.
!     This will overwrite any value of FP that may have been assigned 
!     in step 1.
!
!  3) If the resultant value of FP is not a valid format
!        (C:\Dir1\...\Dir2\)
!     then it will be cleared before the routine returns.
!
     SUBROUTINE ProcessPathAndFileName(Path, FName, FP, FN)
     IMPLICIT   NONE
     CHARACTER (LEN=*), INTENT(IN)    :: Path, FName
     CHARACTER (LEN=*), INTENT(INOUT) :: FP, FN
     INTEGER :: I
     LOGICAL :: OK

     !
     !  Initial values to pass back
     !
     FN = TRIM(FName)
     FP = TRIM(Path)

     !
     !  If FName contains the path info, then separate the 2 parts
     !
     I = INDEX(FN, FilePathSeparator, .TRUE.)     ! find last '\' or '/' character
     IF (I .GT. 0) THEN
        FP = FN(1:I)
        FN = FN(I+1:LEN_TRIM(FName))
     END IF

     !
     !  Make sure the path info is good
     !
     IF (LEN_TRIM(Path) .GT. 0) THEN
        FP = TRIM(Path)
        I = LEN_TRIM(FP)
        IF (FP(I:I) .NE. FilePathSeparator) FP = TRIM(FP) // FilePathSeparator
     END IF

     IF (LEN_TRIM(FP) .GT. 0) THEN
        OK = .TRUE.
        IF (.NOT. CharIsLetter(FP(1:1)) ) OK = .FALSE.
        IF (.NOT.   (FP(2:2) .EQ. ':')  ) OK = .FALSE.
        IF (.NOT.   (FP(3:3) .EQ. FilePathSeparator)) OK = .FALSE.
        IF (.NOT. OK) FP = ''
     END IF

     RETURN

     END SUBROUTINE ProcessPathAndFileName
   
!-------------------------------------------------------------
     SUBROUTINE ConvertFilenameDelimiters(FName)
     IMPLICIT   NONE
     CHARACTER (LEN=*), INTENT(INOUT) :: FName
     INTEGER :: I
     CHARACTER (LEN=1) :: DC       ! the delimiter character

     DC = FilePathSeparator
     DO I = 1, LEN_TRIM(FName)
        IF ((FName(I:I) .EQ. '\') .OR. (FName(I:I) .EQ. '/')) FName(I:I) = DC
     END DO
     END SUBROUTINE ConvertFilenameDelimiters
   
!-------------------------------------------------------------
   SUBROUTINE Caps(S)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: S
   INTEGER   :: I, Offset

   Offset = ICHAR('a') - ICHAR('A')
   DO I=1, LEN_TRIM(S)
      IF ( (S(I:I) .GE. 'a') .AND. (S(I:I) .LE. 'z') ) THEN
        S(I:I) = CHAR(ICHAR(S(I:I)) - Offset)
      ENDIF
   END DO
   RETURN
   END SUBROUTINE Caps
!-------------------------------------------------------------
   SUBROUTINE Small(S)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: S
   INTEGER   :: I, Offset

   Offset = ICHAR('a') - ICHAR('A')
   DO I=1, LEN_TRIM(S)
      IF ( (S(I:I) .GE. 'A') .AND. (S(I:I) .LE. 'Z') ) THEN
        S(I:I) = CHAR(ICHAR(S(I:I)) + Offset)
      ENDIF
   END DO
   RETURN
   END SUBROUTINE Small
!-------------------------------------------------------------
!  Alternate name for the Caps() routine
!-------------------------------------------------------------
   SUBROUTINE UpperCase(S)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: S
   CALL Caps(S)     
   END SUBROUTINE UpperCase
!-------------------------------------------------------------
!  Alternate name for the Small() routine
!-------------------------------------------------------------
   SUBROUTINE LowerCase(S)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: S
   CALL Small(S)     
   END SUBROUTINE LowerCase
!-------------------------------------------------------------
   LOGICAL FUNCTION CharIsLetter(Ch)
   IMPLICIT  NONE
   CHARACTER (LEN=1), INTENT(IN) :: Ch
   INTEGER :: C
   LOGICAL :: L

   C = ICHAR(Ch)
   L = .FALSE.
   IF ((C .GE. IACHAR('a')) .AND. (C .LE. IACHAR('z'))) L = .TRUE.
   IF ((C .GE. IACHAR('A')) .AND. (C .LE. IACHAR('Z'))) L = .TRUE.
   CharIsLetter = L
   END FUNCTION CharIsLetter
!-------------------------------------------------------------
   LOGICAL FUNCTION CharIsNumber(Ch)
   IMPLICIT  NONE
   CHARACTER (LEN=1), INTENT(IN) :: Ch
   INTEGER :: C
   LOGICAL :: L

   C = IACHAR(Ch)
   L = .FALSE.
   IF ((C .GE. IACHAR('0')) .AND. (C .LE. IACHAR('9'))) L = .TRUE.
   CharIsNumber = L
   END FUNCTION CharIsNumber
!-------------------------------------------------------------
   LOGICAL FUNCTION CharIsSpecial(Ch)
   IMPLICIT  NONE
   CHARACTER (LEN=1), INTENT(IN) :: Ch
   INTEGER :: C
   LOGICAL :: L

   C = IACHAR(Ch)
   L = .FALSE.
   IF ((C .GE. IACHAR(' ')) .AND. (C .LE. IACHAR('~'))) THEN
      L = .TRUE.
      IF (CharIsLetter(Ch)) L = .FALSE.
      IF (CharIsNumber(Ch)) L = .FALSE.
   END IF
   CharIsSpecial = L
   END FUNCTION CharIsSpecial
!------------------------------------------------------------------------
   SUBROUTINE StripLeadingBlanks (String)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: String

   String = ADJUSTL(String)
   END SUBROUTINE StripLeadingBlanks
!-------------------------------------------------------------------------
   SUBROUTINE GetTodaysDateTime(FmtDate, FmtTime)
   IMPLICIT  NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: FmtDate, FmtTime
   INTEGER, DIMENSION(8) :: DT_Values
   CHARACTER(LEN=10) :: DT_Date, DT_Time, DT_Zone, Tmp

   FmtDate = ''
   FmtTime = ''
   CALL Date_And_Time(DT_Date, DT_Time, DT_Zone, DT_Values)
   !
   ! Construct date string in form "MM/DD/YYYY"
   !
   IF (LEN(FmtDate) .GE. 10) THEN
      FmtDate = Tmp
      Tmp = DT_Date(5:6) // '/' // DT_Date(7:8) // '/' // DT_Date(1:4)
   END IF
   !
   ! Construct time string in form "HH:MM"
   !
   IF (LEN(FmtDate) .GE. 5) THEN
      FmtTime = Tmp
      Tmp = DT_Time(1:2) // ':' // DT_Time(3:4)
   END IF
   END SUBROUTINE GetTodaysDateTime

!--------------------------------------------------------------------------
!  Accepts a sequence number and returns a string in format "MM/DD/YYYY"
!
   CHARACTER (LEN=10) FUNCTION SeqToDateString10(SeqNum)
   IMPLICIT   NONE
   INTEGER :: SeqNum, D, M, Y
   CHARACTER (LEN=10) :: S

   SeqToDateString10 = ''
   CALL SequenceDate(D, M, Y, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   WRITE(S, 1000, ERR=811) M, D, Y
   DO D = 1, 10
      IF (S(D:D) .EQ. ' ') S(D:D) = '0'
   ENDDO
   SeqToDateString10 = S
   RETURN

 811 WRITE(ErrorMessage, 2001) SeqNum
     CALL PassMsg; GOTO 898
 898 ErrorLevel = 1
     ErrorMessage = '[traceback] : SeqToDateString10...'
     CALL PassMsg
1000 FORMAT(I2.2,'/',I2.2,'/',I4.4)
2001 FORMAT('Error building date string from ', I0)
   END FUNCTION SeqToDateString10

!--------------------------------------------------------------------------
   INTEGER FUNCTION DateString10ToSeq(DS)
   IMPLICIT   NONE
   CHARACTER (LEN=10), INTENT(IN) :: DS
   INTEGER :: Seq

   Seq = DateStringMDYToSeq(DS)
   DateString10ToSeq = Seq
   RETURN

   END FUNCTION DateString10ToSeq

!--------------------------------------------------------------------------
   INTEGER FUNCTION DateStringMDYToSeq(DS)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(IN) :: DS
   INTEGER :: SeqNum, D, M, Y, Slash
   CHARACTER (LEN=50) :: S, SD, SM, SY

   Slash = INDEX(DS, '/')
   IF (Slash .EQ. 0) THEN
      DateStringMDYToSeq = -1
      RETURN
   END IF
   SM = DS(1:Slash-1)
   S = DS(Slash+1:)

   Slash = INDEX(S, '/')
   IF (Slash .EQ. 0) THEN
      DateStringMDYToSeq = -1
      RETURN
   END IF
   SD = S(1:Slash-1)
   SY = S(Slash+1:)

   READ(SM, *, ERR=888) M
   READ(SD, *, ERR=888) D
   READ(SY, *, ERR=888) Y
   IF ((M .LT. 1) .OR. (M .GT. 12)) GOTO 888
   IF ((Y .LT. 1000) .OR. (Y .GT. 2999)) GOTO 888
   IF ((D .LT. 1) .OR. (D .GT. DaysInMonth(M,Y))) GOTO 888

   CALL DateSequence(D, M, Y, SeqNum); IF (ErrorLevel .NE. 0) GOTO 888
   DateStringMDYToSeq = SeqNum
   RETURN

 888  DateStringMDYToSeq = -1
      RETURN
   END FUNCTION DateStringMDYToSeq

!-------------------------------------------------------------------------
      INTEGER FUNCTION DateStringMDHYToSeq(DS)                                  !TECII20050113
      IMPLICIT NONE                                                             !TECII20050112
      CHARACTER (LEN=*), INTENT(IN) :: DS                                       !TECII20050112
      INTEGER :: SeqNum, D, M, H, Y, Slash                                      !TECII20050112
      CHARACTER (LEN=50) :: S, SD, SM, SH, SY                                   !TECII20050112
      Slash = INDEX(DS, '/')                                                    !TECII20050112
      IF (Slash .EQ. 0) THEN                                                    !TECII20050112
       DateStringMDHYToSeq = -1                                                 !TECII20050112
       RETURN                                                                   !TECII20050112
      END IF                                                                    !TECII20050112
      SM = DS(1:Slash-1)                                                        !TECII20050112
      S = DS(Slash+1:)                                                          !TECII20050112
      Slash = INDEX(S, '/')                                                     !TECII20050112
      IF (Slash .EQ. 0) THEN                                                    !TECII20050112
       DateStringMDHYToSeq = -1                                                 !TECII20050112
       RETURN                                                                   !TECII20050112
      END IF                                                                    !TECII20050112
      SD = S(1:Slash-1)                                                         !TECII20050112
      S = S(Slash+1:)                                                           !TECII20050112
      Slash = INDEX(S, '/')                                                     !TECII20050112
      IF (Slash .EQ. 0) THEN                                                    !TECII20050112
       DateStringMDHYToSeq = -1                                                 !TECII20050112
       RETURN                                                                   !TECII20050112
      END IF                                                                    !TECII20050112
      SH = S(1:Slash-1)                                                         !TECII20050112
      SY = S(Slash+1:)                                                          !TECII20050112
      READ(SM, *, ERR=888) M                                                    !TECII20050112
      READ(SD, *, ERR=888) D                                                    !TECII20050112
      READ(SH, *, ERR=888) H                                                    !TECII20050112
      READ(SY, *, ERR=888) Y                                                    !TECII20050112
      IF ((M .LT. 1) .OR. (M .GT. 12)) GOTO 888                                 !TECII20050112
      IF ((Y .LT. 1) .OR. (Y .GT. 9999)) GOTO 888                               !TECII20050114
      IF ((D .LT. 1) .OR. (D .GT. DaysInMonth(M,Y))) GOTO 888                   !TECII20050112
      IF ((H .LT. 1) .OR. (H .GT. 24)) GOTO 888                                 !TECII20050112
      CALL HDMYSequence(H, D, M, Y, SeqNum); IF (ErrorLevel .NE. 0) GOTO 888    !TECII20050112
      DateStringMDHYToSeq = SeqNum                                              !TECII20050112
      RETURN                                                                    !TECII20050112
 888  DateStringMDHYToSeq = -1                                                  !TECII20050112
      RETURN                                                                    !TECII20050112
      END FUNCTION DateStringMDHYToSeq                                          !TECII20050112

      SUBROUTINE HDMYSequence(Hour, Day, Month, Year, SequenceNumber)           !TECII20050112
      IMPLICIT NONE                                                             !TECII20050112
      INTEGER, INTENT(IN) :: Hour, Day, Month, Year                             !TECII20050112
      INTEGER, INTENT(OUT) :: SequenceNumber                                    !TECII20050112
      CALL DateSequence(Day, Month, Year, SequenceNumber)                       !TECII20050112
      SequenceNumber = SequenceNumber * 24 + Hour - 1                           !TECII20050112
      RETURN                                                                    !TECII20050112
      END SUBROUTINE HDMYSequence                                               !TECII20050112

      SUBROUTINE SequenceHDMY(Hour, Day, Month, Year, SequenceNumber)           !TECII20050112
      IMPLICIT NONE                                                             !TECII20050112
      INTEGER, INTENT(IN) :: SequenceNumber                                     !TECII20050112
      INTEGER, INTENT(OUT) :: Hour, Day, Month, Year                            !TECII20050112
      INTEGER              :: Seq
      Seq = SequenceNumber / 24                                                 !TECII20050112
      Hour = SequenceNumber - Seq * 24 + 1                                      !TECII20050112
      CALL SequenceDate(Day, Month, Year, Seq)                                  !TECII20050112
      RETURN                                                                    !TECII20050112
      END SUBROUTINE SequenceHDMY                                               !TECII20050112

!-------------------------------------------------------------------------
   SUBROUTINE DateSequence(Day, Month, Year, SequenceNumber)
!
!     This routine computes the number of the date, with days numbered
!     sequentially from 1 (corresponding to the base date).  The base
!     date must be 1 March on any LEAP YEAR or century boundary. Dates
!     must be between the base date and the base date plus 2,147,483,646.
!     This routine is set up to use only 4-byte integer variables and
!     to avoid intermediate use of reals in the evaluation of expressions.
!     It is a modification of the previous version which used 2-byte integer
!     variables. For reference on the 2-byte version of this subroutine
!     see Dr. Dobb's Journal 80:66-70.  Adapted by Tim Hunter.
!
   IMPLICIT NONE
   INTEGER, PARAMETER   :: BaseYear = 0
   INTEGER, INTENT(OUT) :: SequenceNumber
   INTEGER, INTENT(IN)  :: Day, Month, Year
   INTEGER              :: NumYears, TotC, LeapC, SkipC, NonLeapC

   IF (Year .LE. BaseYear) THEN
      SequenceNumber = DateSeq_MissingDate
      WRITE(ErrorMessage, 9001) Month, Day, Year
      CALL PassMsg
      ErrorLevel = 1
      RETURN
   END IF
   NumYears = Year - BaseYear - 1 + (Month + 9) / 12
   TotC = (BaseYear + NumYears)/100 - (BaseYear/100)
   SkipC = 3 - MOD(BaseYear/100, 4)
   LeapC = (TotC + 3 - SkipC) / 4
   NonLeapC = TotC - LeapC
   SequenceNumber = 365 * NumYears + (NumYears/4) - NonLeapC +        &
                    (153 * MOD(Month + 9, 12) + 2) / 5 + Day
   RETURN
   9001 FORMAT(' DateSequence: Year .LE. BaseYear   MM/DD/YYYY=', I2.2,'/',I2.2,'/',I4)
   END SUBROUTINE DateSequence
!-------------------------------------------------------------------------
   SUBROUTINE SequenceDate(iD, iM, iY, SequenceNumber)
!
!     This routine computes the date of the number, with days numbered
!     sequentially from 1 (corresponding to the base date).  The base date must
!     be 1 March of any year divisible by 4 (i.e. leap years and century years).
!     The base year must be greater than or equal to 0.  Dates must be between
!     the base date and the base date plus 2,147,483,636. This routine is set
!     up to use 4-byte integer variables and to avoid intermediate use of reals
!     in the evaluation of expressions. Adapted from Dr. Dobb's Journal 80:66-70
!     by Tim Hunter.
!
!
   IMPLICIT   NONE
   INTEGER, PARAMETER   :: BaseYear = 0         ! 0  AD
   INTEGER, INTENT(OUT) :: iD, iM, iY
   INTEGER, INTENT(IN)  :: SequenceNumber
   INTEGER              :: SeqNum, CentDays, BY

   IF (SequenceNumber .EQ. DateSeq_MissingDate) THEN
      iD = -99
      iM = -99
      iY = -9999
      RETURN
   END IF
   
   SeqNum = SequenceNumber
   BY = BaseYear
   IF (SeqNum .LT. 0) THEN
      WRITE(ErrorMessage, 9001) SeqNum
      CALL PassMsg
      ErrorLevel = 1
      RETURN
   END IF
!
!  Century Computations
!
   CentDays = 36524                ! since 100 A.D. is not a leap year
   DO WHILE (SeqNum .GT. CentDays)
      BY = BY + 100
      SeqNum = SeqNum - CentDays
      CentDays = 36524
      IF (((BY+100)/400*400) .EQ. (BY+100)) CentDays = 36525
   END DO
!
!  At this point, SeqNum is less than 100 years.  The following code is
!  identical to the original 2-byte version.
!
   iY = (SeqNum - 1 - SeqNum/1461) / 365
   iD = SeqNum - 365*iY - iY/4
   iM = MOD ((5*iD - 3)/153 + 2, 12) + 1
   iY = iY + BY + 1 - (iM+9)/12
   iD = iD - (153 * MOD(iM+9, 12) + 2) / 5
   RETURN
   9001 FORMAT(' SequenceDate: SequenceNumber <0 not allowed.   SeqNum=', I0)
   END SUBROUTINE SequenceDate
!------------------------------------------------------------------------------
   INTEGER FUNCTION JulianDayToSeqNum(Year, JDay)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Year, JDay
   INTEGER             :: Seq
   
   JulianDayToSeqNum = -1
   CALL DateSequence(1, 1, Year, Seq); IF (ErrorLevel .NE. 0) RETURN
   JulianDayToSeqNum = Seq + JDay - 1
   END FUNCTION JulianDayToSeqNum
!------------------------------------------------------------------------------
   SUBROUTINE SeqNumToJulianDay(Seq, JDay, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN)  :: Seq
   INTEGER, INTENT(OUT) :: Year, JDay
   INTEGER              :: D, M, SeqJ1

   CALL SequenceDate(D, M, Year, Seq); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(1, 1, Year, SeqJ1); IF (ErrorLevel .NE. 0) RETURN
   JDay = Seq - SeqJ1 + 1
   END SUBROUTINE SeqNumToJulianDay
!-------------------------------------------------------------------------
   INTEGER FUNCTION DaysInYear(Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) ::  Year
   INTEGER ::  Seq1, Seq2

   DaysInYear = -1
   IF (Year .LT. 1)    GOTO 899
   IF (Year .GT. 2999) GOTO 899
   CALL DateSequence( 1,  1, Year, Seq1); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(31, 12, Year, Seq2); IF (ErrorLevel .NE. 0) RETURN
   DaysInYear = Seq2 - Seq1
   RETURN
899   ErrorMessage = 'Bad parameter in routine DaysInYear'
      CALL PassMsg
      ErrorLevel = 1
      RETURN
   END FUNCTION DaysInYear
!-------------------------------------------------------------------------
   INTEGER FUNCTION DaysInMonth (Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) ::  Month, Year
   INTEGER ::  M1, Y1, Seq1, M2, Y2, Seq2

   DaysInMonth = -1
   IF (Month .LT. 1)   GOTO 899
   IF (Month .GT. 12)  GOTO 899
   IF (Year .LT. 1)    GOTO 899
   IF (Year .GT. 2999) GOTO 899
   M1 = Month
   Y1 = Year
   M2 = Month + 1
   Y2 = Year
   IF (M2 .GT. 12) THEN
      M2 = M2 - 12
      Y2 = Y2 + 1
   ENDIF
   CALL DateSequence(1, M1, Y1, Seq1); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(1, M2, Y2, Seq2); IF (ErrorLevel .NE. 0) RETURN
   DaysInMonth = Seq2 - Seq1
   RETURN
899   ErrorMessage = 'Bad parameter in routine DaysInMonth'
      CALL PassMsg
      ErrorLevel = 1
      RETURN
   END FUNCTION DaysInMonth
!------------------------------------------------------------------------
   LOGICAL FUNCTION IsLastDayOfMonth(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year
   INTEGER :: I
   LOGICAL :: Flag

   IsLastDayOfMonth = .FALSE.   ! dummy assignment to eliminate compiler warning
   Flag = .FALSE.
   I = DaysInMonth(Month, Year); IF(ErrorLevel .NE. 0) RETURN
   IF (Day .EQ. I) Flag = .TRUE.
   IsLastDayOfMonth = Flag
   END FUNCTION IsLastDayOfMonth
!-------------------------------------------------------------------------
   INTEGER FUNCTION DaysInQtrMon(Q, M, Y)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Q, M, Y
   INTEGER :: DM, D1, D2

   DaysInQtrMon = -1
   DM = DaysInMonth(M, Y);        IF(ErrorLevel .NE. 0) RETURN
   D2 = LastDayOfQtrMon(DM, Q);   IF(ErrorLevel .NE. 0) RETURN
   D1 = FirstDayOfQtrMon(DM, Q);  IF(ErrorLevel .NE. 0) RETURN
   DaysInQtrMon = D2 - D1 + 1
   END FUNCTION DaysInQtrMon
!------------------------------------------------------------------------
   INTEGER FUNCTION DayOfQtrMon(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year
   DayOfQtrMon = Day - FirstDayOfQtrMon(Day, Month, Year) + 1
   END FUNCTION DayOfQtrMon
!------------------------------------------------------------------------
   INTEGER FUNCTION QtrMonNumber (D, M, Y)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: D, M, Y
   INTEGER :: I, Days, Q
   QtrMonNumber = -1
   Days = DaysInMonth(M, Y);         IF (ErrorLevel .NE. 0) RETURN
   DO I = 4, 1, -1
     Q = LastDayOfQtrMon(Days, I);   IF (ErrorLevel .NE. 0) RETURN
     IF (D .LE. Q) QtrMonNumber = I
   ENDDO
   END FUNCTION QtrMonNumber
!------------------------------------------------------------------------
!  Day = 1..8
   INTEGER FUNCTION SequenceFromYMQD(Year, Mon, Qtr, Day)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Year, Mon, Qtr, Day
   INTEGER :: Q, DM, Seq

   SequenceFromYMQD = -1
   DM = 0
   DO Q = 1, Qtr-1
      DM = DM + DaysInQtrMon(Q, Mon, Year)
   END DO
   DM = DM + Day
   CALL DateSequence(DM, Mon, Year, Seq);  IF(ErrorLevel .NE. 0) RETURN
   SequenceFromYMQD = Seq
   END FUNCTION SequenceFromYMQD
!------------------------------------------------------------------------
   LOGICAL FUNCTION IsFirstDayOfQtrMon(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year
   INTEGER :: I, J
   LOGICAL :: Flag

   IsFirstDayOfQtrMon = .FALSE.   ! dummy assignment to eliminate compiler warning
   I = DaysInMonth(Month, Year); IF(ErrorLevel .NE. 0) RETURN
   Flag = .FALSE.
   DO J = 1, 4
      IF (Day .EQ. FirstDayOfQtrMon(I,J)) Flag = .TRUE.
      IF (ErrorLevel .NE. 0) RETURN
   END DO
   IsFirstDayOfQtrMon = Flag
   END FUNCTION IsFirstDayOfQtrMon
!------------------------------------------------------------------------
   LOGICAL FUNCTION IsLastDayOfQtrMon(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year
   INTEGER :: I, J
   LOGICAL :: Flag

   IsLastDayOfQtrMon = .FALSE.   ! dummy assignment to eliminate compiler warning
   I = DaysInMonth(Month, Year); IF(ErrorLevel .NE. 0) RETURN
   Flag = .FALSE.
   DO J = 1, 4
      IF (Day .EQ. LastDayOfQtrMon(I,J)) Flag = .TRUE.
      IF (ErrorLevel .NE. 0) RETURN
   END DO
   IsLastDayOfQtrMon = Flag
   END FUNCTION IsLastDayOfQtrMon
!------------------------------------------------------------------------------
!  Adjust the sequence number to the first day of the quarter-month.
!
   SUBROUTINE AdjustToStartOfQtrMonth(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr, I
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   I = FirstDayOfQtrMon(SeqNum);          IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(I, Mn, Yr, SeqNum);  IF (ErrorLevel .NE. 0) RETURN
   END SUBROUTINE AdjustToStartOfQtrMonth
!------------------------------------------------------------------------------
!  Adjust the sequence number to the last day of the quarter-month.
!
   SUBROUTINE AdjustToEndOfQtrMonth(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr, I
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   I = LastDayOfQtrMon(SeqNum);           IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(I, Mn, Yr, SeqNum);  IF (ErrorLevel .NE. 0) RETURN
   END SUBROUTINE AdjustToEndOfQtrMonth
!-----------------------------------------------------------------------------
   INTEGER FUNCTION GetNumYears(SSeq, ESeq)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: SSeq, ESeq
   INTEGER :: D1, M1, Y1, D2, M2, Y2

   GetNumYears = -1
   CALL SequenceDate(D1, M1, Y1, SSeq); IF (ErrorLevel .NE. 0) RETURN
   CALL SequenceDate(D2, M2, Y2, ESeq); IF (ErrorLevel .NE. 0) RETURN
   IF ((D1 .NE.  1) .OR. (M1 .NE.  1)) Y1 = Y1 + 1
   IF ((D2 .NE. 31) .OR. (M2 .NE. 12)) Y2 = Y2 - 1
   GetNumYears = Y2 - Y1 + 1
   END FUNCTION GetNumYears
!-----------------------------------------------------------------------------
   INTEGER FUNCTION GetNumMonths(SSeq, ESeq)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: SSeq, ESeq
   INTEGER :: D1, M1, Y1, D2, M2, Y2

   GetNumMonths = -1
   CALL SequenceDate(D1, M1, Y1, SSeq); IF (ErrorLevel .NE. 0) RETURN
   CALL SequenceDate(D2, M2, Y2, ESeq); IF (ErrorLevel .NE. 0) RETURN
   IF (D1 .NE. 1) M1 = M1 + 1
   IF (.NOT. IsLastDayOfMonth(D2, M2, Y2)) M2 = M2 - 1; IF(ErrorLevel .NE. 0) RETURN
   GetNumMonths = (Y2-Y1)*12 + M2 - M1 + 1
   END FUNCTION GetNumMonths
!-----------------------------------------------------------------------------
   INTEGER FUNCTION GetNumQtrMons(SSeq, ESeq)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: SSeq, ESeq
   INTEGER :: D1, M1, Y1, D2, M2, Y2, I, Seq, Q1, Q2

   GetNumQtrMons = -1
   CALL SequenceDate(D1, M1, Y1, SSeq);     IF (ErrorLevel .NE. 0) RETURN
   I = FirstDayOfQtrMon(D1, M1, Y1);        IF (ErrorLevel .NE. 0) RETURN
   IF (D1 .NE. I) THEN
      I = LastDayOfQtrMon(D1, M1, Y1);      IF (ErrorLevel .NE. 0) RETURN
      CALL DateSequence(D1, M1, Y1, Seq);   IF (ErrorLevel .NE. 0) RETURN
      CALL SequenceDate(D1, M1, Y1, Seq+1); IF (ErrorLevel .NE. 0) RETURN
   END IF 
   Q1 = QtrMonNumber(D1, M1, Y1);           IF (ErrorLevel .NE. 0) RETURN
   CALL SequenceDate(D2, M2, Y2, ESeq);     IF (ErrorLevel .NE. 0) RETURN
   I = LastDayOfQtrMon(D2, M2, Y2);         IF (ErrorLevel .NE. 0) RETURN
   IF (D2 .NE. I) THEN
      I = FirstDayOfQtrMon(D2, M2, Y2);     IF (ErrorLevel .NE. 0) RETURN
      CALL DateSequence(D2, M2, Y2, Seq);   IF (ErrorLevel .NE. 0) RETURN
      CALL SequenceDate(D2, M2, Y2, Seq-1); IF (ErrorLevel .NE. 0) RETURN
   END IF 
   Q2 = QtrMonNumber(D2, M2, Y2);           IF (ErrorLevel .NE. 0) RETURN
   GetNumQtrMons = (Y2-Y1)*48 + (M2-M1)*4 + Q2-Q1+1
   END FUNCTION GetNumQtrMons
!-----------------------------------------------------------------------------
   INTEGER FUNCTION GetNumWeeks(SSeq, ESeq)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: SSeq, ESeq
   INTEGER :: I, J
   I = SSeq + 6
   J = 0
   DO WHILE (I .LE. ESeq)
      J = J + 1
      I = I + 7
   END DO
   GetNumWeeks = J
   END FUNCTION GetNumWeeks
!------------------------------------------------------------------------------
!  Adjust the sequence number to the first day of the month.
!
   SUBROUTINE AdjustToStartOfMonth(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence( 1, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   END SUBROUTINE AdjustToStartOfMonth
!------------------------------------------------------------------------------
!  Adjust the sequence number to the last day of the month.
!
   SUBROUTINE AdjustToEndOfMonth(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   Mn = Mn + 1
   IF (Mn .GT. 12) THEN
      Mn = Mn - 12
      Yr = Yr + 1
   ENDIF
   CALL DateSequence( 1, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   SeqNum = SeqNum - 1
   END SUBROUTINE AdjustToEndOfMonth
!------------------------------------------------------------------------------
!  Adjust the sequence number to the first day of the year.
!
   SUBROUTINE AdjustToStartOfYear(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence( 1,  1, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   END SUBROUTINE AdjustToStartOfYear
!------------------------------------------------------------------------------
!  Adjust the sequence number to the last day of the month.
!
   SUBROUTINE AdjustToEndOfYear(SeqNum)
   IMPLICIT   NONE
   INTEGER, INTENT(INOUT) :: SeqNum
   INTEGER :: Dy, Mn, Yr
   CALL SequenceDate(Dy, Mn, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   CALL DateSequence(31, 12, Yr, SeqNum); IF (ErrorLevel .NE. 0) RETURN
   END SUBROUTINE AdjustToEndOfYear
   
   
!-----------------------------------------------------------------------------
   SUBROUTINE FileNameNoPath(LongName, ShortName)
   IMPLICIT NONE
   CHARACTER (LEN=*), INTENT(IN)  :: LongName
   CHARACTER (LEN=*), INTENT(OUT) :: ShortName
   INTEGER :: I

   !   
   !  Handle Windows paths or Linux paths
   !
   I = INDEX(LongName, FilePathSeparator, .TRUE.)   ! find last \ or / in filename
   IF (I .GT. 0) THEN
      ShortName = LongName(I+1:)
   ELSE
      ShortName = LongName
   END IF
   END SUBROUTINE FileNameNoPath
     
   
!-----------------------------------------------------------------------------
      SUBROUTINE CopyFile (FName1, FName2)
!
!  This routine is used to copy a file in a "Fortran-standard" manner.
!  It will work correctly for binary as well as ASCII files.
!
      IMPLICIT NONE
      CHARACTER (LEN=*), INTENT(IN) :: FName1, FName2

      INTEGER, PARAMETER      :: BufSize = 256
      INTEGER                 :: I, J, IOS, UNum1, UNum2
      INTEGER                 :: BR, Rin, Rout
      LOGICAL                 :: Flag, IsThere
      INTEGER (KIND=INTEGER1) :: AByte, FileBuffer(BufSize)

!
!  Does the file exist?  If not, then there is nothing to do.
!
      INQUIRE(FILE=TRIM(FName1), EXIST=Flag)
      IF (.NOT. Flag) THEN
         ErrorMessage = 'Error copying file.  '//TRIM(FName1)//' does not exist.'
         GOTO 898
      END IF

!
!  Open the files
!
      INQUIRE(FILE=TRIM(FName1), EXIST=IsThere)
      IF (.NOT. IsThere) GOTO 811
      UNum1 = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=UNum1, FILE=TRIM(FName1), STATUS='OLD',              &
     &     ACCESS='DIRECT', FORM='UNFORMATTED', RECL=1, ERR=811)
      CALL FileWasOpened(UNum1); IF (ErrorLevel .NE. 0) RETURN

      UNum2 = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=UNum2, FILE=TRIM(FName2), STATUS='REPLACE',          &
     &     ACCESS='DIRECT', FORM='UNFORMATTED', RECL=1, ERR=821)
      CALL FileWasOpened(UNum2); IF (ErrorLevel .NE. 0) RETURN

!
!  Read and write using a buffer to reduce disk head movement (thrashing)
!
!   BR = bytes already read into the buffer
!
      Rin  = 1
      Rout = 0
      BR = 0
      READ(UNum1, REC=Rin, IOSTAT=IOS) AByte
      DO WHILE (IOS .EQ. 0)
         BR = BR + 1
         FileBuffer(BR) = AByte
         IF (BR .EQ. BufSize) THEN
            DO I = 1, BR
               J = Rout + I
               WRITE(UNum2, REC=J, ERR=823) FileBuffer(I)
            END DO
            Rout = Rout + BR
            BR = 0
         END IF
         Rin = Rin + 1
         READ(UNum1, REC=Rin, IOSTAT=IOS) AByte
      END DO
      DO I = 1, BR
         J = Rout + I
         WRITE(UNum2, REC=J, ERR=823) FileBuffer(I)
      END DO
      
      CLOSE(UNum1)
      CALL FileWasClosed(UNum1);      IF (ErrorLevel .NE. 0) RETURN
      CLOSE(UNum2)
      CALL FileWasClosed(UNum2);      IF (ErrorLevel .NE. 0) RETURN
      GOTO 999

!
!  Error while writing
!
 811  ErrorMessage =  'Error opening '//TRIM(FName1)//' for copy.'
      CALL PassMsg;  GOTO 898
 821  ErrorMessage =  'Error opening '//TRIM(FName2)//' for copy.'
      CALL PassMsg;  GOTO 898
 823  ErrorMessage =  'Error writing to '//TRIM(FName2)//' for copy.'
      CALL PassMsg;  GOTO 898

 898  CALL PassMsg
      ErrorLevel = 1
 999  RETURN

      END SUBROUTINE CopyFile
!-----------------------------------------------------------------------------
      SUBROUTINE RenameFile (File1, File2, Success)
      IMPLICIT NONE
      LOGICAL              :: Success
      CHARACTER (LEN=*)    :: File1, File2

      Success = .FALSE.

!
!  Attempt to copy File1 to File2
!
      CALL CopyFile(File1, File2)

      IF (ErrorLevel .NE. 0) THEN
         CALL DeleteFile(File2)
         SUCCESS = .FALSE.
         RETURN
      END IF

!
!  If we get to here then the copy worked.  Delete the old file 
!  because the new one is good.
!
      CALL DeleteFile(File1)
      Success = .TRUE.
      RETURN

      END SUBROUTINE RenameFile

!-----------------------------------------------------------------------------
      SUBROUTINE Rename_SYSTEM (Name1, Name2, Success)
      IMPLICIT NONE
      CHARACTER (LEN=*)   :: Name1, Name2
      LOGICAL             :: Success
      CHARACTER (LEN=100) :: CL

#if defined(LINUX)
      CL = 'if [ -f '//TRIM(Name2)//' ]; then rm '//TRIM(Name2)//'; fi'
      CALL SYSTEM(TRIM(CL))
      CL = 'mv '//TRIM(Name1)//' '//TRIM(Name2)//' > /dev/null'
      CALL SYSTEM(TRIM(CL))
#else
      CL = 'IF EXIST '//TRIM(Name2)//' DEL '//TRIM(Name2)//' > NUL'
      CALL SYSTEM(TRIM(CL))
      CL = 'REN '//TRIM(Name1)//' '//TRIM(Name2)//' > NUL'
      CALL SYSTEM(TRIM(CL))
#endif
      Success = .TRUE.
      END SUBROUTINE Rename_SYSTEM
      
!-----------------------------------------------------------------------------
!
!  This routine is used to delete file(s) in a "Fortran-standard" manner.
!
      SUBROUTINE DeleteFile (FileSpec)
      IMPLICIT NONE
      CHARACTER (LEN=*), INTENT(IN) :: FileSpec
      INTEGER :: I, IOS, ListU, FileU
      LOGICAL :: Flag
      CHARACTER(LEN=90)  :: ListFile, FName
      CHARACTER(LEN=150) :: CL

      ListFile = 'xxxxxxTemporaryListFile.tmp'
#if defined(LINUX)
      CL = 'ls -1 '//TRIM(FileSpec)//' > '//TRIM(ListFile) // ' 2> /dev/null'
      CALL SYSTEM(TRIM(CL))
#else
      CL = 'dir/b '//TRIM(FileSpec)//' > '//TRIM(ListFile)
      CALL SYSTEM(TRIM(CL))
#endif

      !
      !  Loop through the results of that system command
      !      
      ListU = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=ListU, FILE=TRIM(ListFile), STATUS='OLD', IOSTAT=I)
      CALL FileWasOpened(ListU)
      READ(ListU, *, IOSTAT=IOS) FName
      DO WHILE (IOS .EQ. 0) 
         INQUIRE(FILE=TRIM(FName), EXIST=Flag)
         IF (Flag) THEN
            FileU = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
            OPEN(UNIT=FileU, FILE=TRIM(FName), STATUS='OLD', IOSTAT=I)
            CLOSE(FileU, STATUS='DELETE', IOSTAT=I)
            IF (I .NE. 0) THEN
                ErrorMessage = 'Error deleting '//TRIM(FName)
                CLOSE(ListU, STATUS='DELETE')
                CALL FileWasClosed(ListU)
                RETURN
            END IF
         END IF
         READ(ListU, *, IOSTAT=IOS) FName
      END DO
      CLOSE(ListU, STATUS='DELETE')
      CALL FileWasClosed(ListU)
      RETURN

      END SUBROUTINE DeleteFile

!-----------------------------------------------------------------------------
!
!  This routine is used to delete file(s) using system commands.
!  Wildcard specs DO work here.
!  ***** Note that this is not working correctly in linux *****
!  ***** Gonna have to do a bit more R&D on it. *****
!
      SUBROUTINE DeleteFile_SYSTEM (FName)
      IMPLICIT NONE
      CHARACTER (LEN=*), INTENT(IN) :: FName
      CHARACTER (LEN=500) :: CL

#if defined(LINUX)
      CL = 'if [ -f '//TRIM(FName)//' ]; then rm '//TRIM(FName)//'; fi'
      CALL SYSTEM(TRIM(CL))
#else
      CL = 'IF EXIST '//TRIM(FName)//' DEL '//TRIM(FName)//' > NUL'
      CALL SYSTEM(TRIM(CL))
#endif

      END SUBROUTINE DeleteFile_SYSTEM
!-------------------------------------------------------------------------
!
!     This routines is used to check for the existence of a file called
!     CANCEL.INT.  If it exists, then the user has requested that the
!     program execution be terminated.  There are a few places during the
!     AHPS execution where an immediate STOP would have disastrous
!     consequences.  Thus, I've included this test so that any program
!     can check this routine whenever it is a SAFE time to immediately
!     terminate.  (Or it can *make it* safe to terminate if the user has
!     requested that.)
!
     LOGICAL FUNCTION UserWantsToCancel()
     IMPLICIT    NONE
     LOGICAL  :: IsThere
      
     INQUIRE(FILE='CANCEL.INT', EXIST=IsThere)
     IF (IsThere) THEN
        ErrorMessage = 'User has requested that the procedure be cancelled.'
        CALL PassMsg
        ErrorLevel = -99
        UserWantsToCancel = .TRUE.
        RETURN
     END IF

     UserWantsToCancel = .FALSE.
     RETURN
     END FUNCTION UserWantsToCancel
!-------------------------------------------------------------------------
      SUBROUTINE ClearFilesOpen()
      IMPLICIT   NONE
      INTEGER  :: I

      OpenedFiles = 0
      DO I = 1, MaxOpenedFiles
         OpenedFileUnits(I) = -1
      END DO
      END SUBROUTINE ClearFilesOpen
!-------------------------------------------------------------------------
      SUBROUTINE FileWasOpened(UNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) ::  UNum
      INTEGER             ::  I, J
      CHARACTER (LEN=6)   ::  SNum

      J = -1
      DO I = 1, OpenedFiles
         IF (OpenedFileUnits(I) .EQ. UNum) J = I
      END DO
      IF (J .GE. 0) THEN
        WRITE(SNum, '(I0)') UNum
        ErrorMessage = 'Unit '//TRIM(SNum)//' was already OPEN!'
        GOTO 898
      END IF
      IF (OpenedFiles .GE. MaxOpenedFiles) THEN
        ErrorMessage = 'Programmed limit on number of open files was exceeded!'
        GOTO 898
      END IF
      OpenedFiles = OpenedFiles + 1
      OpenedFileUnits(OpenedFiles) = UNum
      RETURN
 898  ErrorLevel = 1
      CALL PassMsg
      END SUBROUTINE FileWasOpened
!-------------------------------------------------------------------------
      SUBROUTINE FileWasClosed(UNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) ::  UNum
      INTEGER             ::  I, J

      J = -1
      DO I = 1, OpenedFiles
         IF (OpenedFileUnits(I) .EQ. UNum) J = I
      END DO
      IF (J .EQ. -1) RETURN
!
!     Move last entry in array to the empty slot and decrement the counter
!
      OpenedFileUnits(J) = OpenedFileUnits(OpenedFiles)
      OpenedFileUnits(OpenedFiles) = -1
      OpenedFiles = OpenedFiles - 1
      END SUBROUTINE FileWasClosed
!-------------------------------------------------------------------------
      LOGICAL FUNCTION FileIsOpen(UNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) ::  UNum

      IF (UnitIsAvailable(UNum)) THEN
         FileIsOpen = .FALSE.
      ELSE
         FileIsOpen = .TRUE.
      END IF
      END FUNCTION FileIsOpen
!-------------------------------------------------------------------------
      SUBROUTINE CloseAllFiles()
      IMPLICIT   NONE
      INTEGER  ::  I, J, K, IOS

      K = OpenedFiles
      DO I = K, 1, -1
         J = OpenedFileUnits(I)
         CLOSE(J, IOSTAT=IOS)       ! don't choke when closing file, even if not open
         OpenedFileUnits(I) = -1
         OpenedFiles = OpenedFiles - 1
      END DO
      END SUBROUTINE CloseAllFiles
!-------------------------------------------------------------------------
      INTEGER FUNCTION GetFreeUnitNumber()
      IMPLICIT  NONE
      INTEGER :: UNum, TNum     
      LOGICAL :: Found
      
      UNum = -1
      TNum = 200                ! start at 200 so first test will be on unit=201
      Found = .FALSE.           ! initial value to force loop traversal
      DO WHILE ((.NOT. Found) .AND. (TNum .LT. 399))
         TNum = TNum + 1
         IF (UnitIsAvailable(TNum)) THEN
            Found = .TRUE.
            UNum = TNum
         END IF
      END DO
      IF (UNum .EQ. -1) THEN
         ErrorMessage = 'Unable to get available unit number'
         CALL PassMsg
         GOTO 898
      END IF
      GetFreeUnitNumber = UNum
      RETURN
 898  ErrorLevel = 1
      GetFreeUnitNumber = UNum
      END FUNCTION GetFreeUnitNumber
!--------------------------------------------------------------------------
      LOGICAL FUNCTION UnitIsInUse(UNum)
      IMPLICIT  NONE
      INTEGER, INTENT(IN) :: UNum
      INTEGER :: IOS
      LOGICAL :: UnitInUse
      INQUIRE(UNIT=UNum, Opened=UnitInUse, IOSTAT=IOS)
      IF (IOS .EQ. 0) THEN
         UnitIsInUse = UnitInUse
         RETURN
      ELSE
         UnitIsInUse = .TRUE.
         RETURN
      END IF
      END FUNCTION UnitIsInUse
!--------------------------------------------------------------------------
      LOGICAL FUNCTION UnitIsAvailable(UNum)
      IMPLICIT  NONE
      INTEGER, INTENT(IN) :: UNum
      UnitIsAvailable = (.NOT. UnitIsInUse(UNum))
      RETURN
      END FUNCTION UnitIsAvailable
!--------------------------------------------------------------------------
     LOGICAL FUNCTION UserRequestedTermination()
     IMPLICIT   NONE
     LOGICAL :: Flag      
     INQUIRE(FILE='CANCEL.INT', EXIST=Flag)
     IF (Flag) THEN
        ErrorMessage = 'User canceled the process.'
        CALL PassMsg
        ErrorLevel = 9999
     END IF
     UserRequestedTermination = Flag 
     END FUNCTION UserRequestedTermination
!-------------------------------------------------------------------------
      SUBROUTINE Round(Var, Inodgt)
      IMPLICIT NONE
      REAL, INTENT(INOUT) :: Var
      INTEGER, INTENT(IN) :: Inodgt
      REAL (KIND=REAL8) ::  Varval, Xrcc
!
!     Round the number to the specified number of significant digits.
!
!     DO NOT PASS A ZERO (Var = 0) TO THIS ROUTINE!
!
      IF (Abs(Var) .LT. 1.0e-30) THEN
         ErrorLevel = 1
         ErrorMessage = 'Cannot ROUND zero argument'
         CALL PassMsg
         RETURN
      END IF
      Varval = Var
      Xrcc = 10.0D+0**(1-Inodgt+INT(DLOG10(Varval*.999999999999999D+0)))
      IF (Varval .LE. 1.0D+0) Xrcc = Xrcc / 10.0D+0
      Varval = Varval + Xrcc / 2.0D+0
      Xrcc = 10.0D+0**(1-Inodgt+INT(DLOG10(Varval*.999999999999999D+0)))
      IF (Varval .LE. 1.0D+0) Xrcc = Xrcc / 10.0D+0
      Varval = INT(Varval * 1.00000000000001D+0 / Xrcc) * Xrcc
      Var = REAL(Varval)
      RETURN
      END SUBROUTINE Round
!-------------------------------------------------------------------------
      LOGICAL FUNCTION REQUAL(A, B)
      IMPLICIT NONE
      REAL, INTENT(IN) :: A, B
      REAL :: Epsilon, SA, SB
      
      SA = SPACING(A)
      SB = SPACING(B)
      Epsilon = MAX(SA,SB)
      IF (ABS(A-B) .LT. Epsilon) THEN
         REQUAL = .TRUE.
      ELSE
         REQUAL = .FALSE.
      END IF
      RETURN
      END FUNCTION REQUAL

!-------------------------------------------------------------------------
      LOGICAL FUNCTION IsMissing(A)
      IMPLICIT NONE
      REAL, INTENT(IN) :: A
      LOGICAL :: F1, F2
      F1 = REQUAL(A, MissingData_Real)
      F2 = A .LE. MissingData_Real_Test
      IsMissing = F1 .OR. F2
      RETURN
      END FUNCTION IsMissing

!-----------------------------------------------------
!  These are the routines referenced in INTERFACE DayOfYear
!
!  I = DayOfYear(integer_variable) will use DayOfYearFromSeq
!  I = DayOfYear(int, int, int) will use DayOfYearFromDMY
!
       INTEGER FUNCTION DayOfYearFromSeq(Seq)
       IMPLICIT  NONE
       INTEGER, INTENT(IN) :: Seq
       INTEGER :: SeqJan1, Dy, Mn, Yr
       DayOfYearFromSeq = -9999
       CALL SequenceDate(Dy, Mn, Yr, Seq)   ; IF (ErrorLevel .NE. 0) RETURN
       CALL DateSequence(1, 1, Yr, SeqJan1) ; IF (ErrorLevel .NE. 0) RETURN
       DayOfYearFromSeq = Seq - SeqJan1 + 1
       END FUNCTION DayOfYearFromSeq

       !-------------------------------------------------------------
       INTEGER FUNCTION DayOfYearFromDMY(Dy, Mn, Yr)
       IMPLICIT  NONE
       INTEGER, INTENT(IN) :: Dy, Mn, Yr
       INTEGER :: SeqJan1, SeqNow
       DayOfYearFromDMY = -9999
       IF ((Dy .LT. 1) .OR. (Dy .GT. 31)) THEN
          ErrorMessage = 'Invalid day specified in DayOfYear() function!'
          CALL PassMsg;  GOTO 899
       END IF
       IF ((Mn .LT. 1) .OR. (Mn .GT. 12)) THEN
          ErrorMessage = 'Invalid month specified in DayOfYear() function!'
          CALL PassMsg;  GOTO 899
       END IF
       IF ((Yr .LT. 1) .OR. (Yr .GT. 9999)) THEN
          ErrorMessage = 'Invalid year specified in DayOfYear() function!'
          CALL PassMsg;  GOTO 899
       END IF
       CALL DateSequence(Dy, Mn, Yr, SeqNow)  ; IF (ErrorLevel .NE. 0) RETURN
       CALL DateSequence( 1,  1, Yr, SeqJan1) ; IF (ErrorLevel .NE. 0) RETURN
       DayOfYearFromDMY = SeqNow - SeqJan1 + 1
       RETURN

  899  ErrorLevel = 1
       RETURN
       END FUNCTION DayOfYearFromDMY

!-----------------------------------------------------
!  These are the routines referenced in INTERFACE FirstDayOfQtrMon
!
!  I = FirstDayOfQtrMon(int)           will use StartOfQtr1
!  I = FirstDayOfQtrMon(int, int)      will use StartOfQtr2
!  I = FirstDayOfQtrMon(int, int, int) will use StartOfQtr3
!
       INTEGER FUNCTION StartOfQtr1(Seq)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Seq
       INTEGER :: Dy, Mn, Yr
       StartOfQtr1 = -1
       CALL SequenceDate(Dy, Mn, Yr, Seq)   ; IF (ErrorLevel .NE. 0) RETURN
       StartOfQtr1 = StartOfQtr3(Dy, Mn, Yr); IF (ErrorLevel .NE. 0) RETURN
       END FUNCTION StartOfQtr1
       
       !-------------------------------------------------------------
       INTEGER FUNCTION StartOfQtr2(Days, QtrNumber)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Days, QtrNumber
       INTEGER :: Q(4), QQ
       StartOfQtr2 = -1
       IF (QtrNumber .EQ. 0) THEN
          StartOfQtr2 = 0
          ErrorMessage = 'Invalid parameter in routine FirstDayOfQtrMon(D,Q)'
          CALL PassMsg;  GOTO 899
       END IF
       IF (Days .EQ. 28) Q(:) = Q28(:)
       IF (Days .EQ. 29) Q(:) = Q29(:)
       IF (Days .EQ. 30) Q(:) = Q30(:)
       IF (Days .EQ. 31) Q(:) = Q31(:)
       IF (QtrNumber .EQ. 1) THEN
          StartOfQtr2 = 1
          RETURN
       END IF
       QQ = QtrNumber - 1
       StartOfQtr2 = Q(QQ) + 1
       RETURN

899    ErrorLevel = 1
       RETURN
       END FUNCTION StartOfQtr2

       !-------------------------------------------------------------
       INTEGER FUNCTION StartOfQtr3(Day, Month, Year)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Day, Month, Year
       INTEGER :: DD, DM, Q
       StartOfQtr3 = -1
       IF (Year .LT. 1)    GOTO 801
       IF (Year .GT. 2999) GOTO 801
       IF (Month .LT. 1)   GOTO 801
       IF (Month .GT. 12)  GOTO 801
       DD = DaysInMonth(Month, Year); IF (ErrorLevel .NE. 0) RETURN
       IF (Day .LT. 1)     GOTO 801
       IF (Day .GT. DD)    GOTO 801
       DM = DaysInMonth(Month, Year)      ; IF (ErrorLevel .NE. 0) RETURN
       Q  = QtrMonNumber(Day, Month, Year); IF (ErrorLevel .NE. 0) RETURN
       StartOfQtr3 = StartOfQtr2(DM, Q)   ; IF (ErrorLevel .NE. 0) RETURN
       RETURN

  801  ErrorMessage = 'Invalid parameter in routine FirstDayOfQtrMon(D,M,Y)'
       CALL PassMsg
       ErrorLevel = 1
       StartOfQtr3 = 0
       RETURN
       END FUNCTION StartOfQtr3

!-----------------------------------------------------
!  These are the routines referenced in INTERFACE LastDayOfQtrMon
!
!  I = LastDayOfQtrMon(int)           will use EndOfQtr1
!  I = LastDayOfQtrMon(int, int)      will use EndOfQtr2
!  I = LastDayOfQtrMon(int, int, int) will use EndOfQtr3
!
       INTEGER FUNCTION EndOfQtr1(Seq)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Seq
       INTEGER :: Dy, Mn, Yr
       EndOfQtr1 = -1
       CALL SequenceDate(Dy, Mn, Yr, Seq) ; IF (ErrorLevel .NE. 0) RETURN
       EndOfQtr1 = EndOfQtr3(Dy, Mn, Yr)  ; IF (ErrorLevel .NE. 0) RETURN
       END FUNCTION EndOfQtr1

       !-------------------------------------------------------------
       INTEGER FUNCTION EndOfQtr2(DaysInMon, QtrNumber)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: DaysInMon, QtrNumber
       INTEGER :: Q(4)
       EndOfQtr2 = -1
       IF (QtrNumber .LT. 1)   GOTO 801
       IF (QtrNumber .GT. 4)   GOTO 801
       IF (DaysInMon .LT. 28)  GOTO 801
       IF (DaysInMon .GT. 31)  GOTO 801
       IF (DaysInMon .EQ. 28) Q(:) = Q28(:)
       IF (DaysInMon .EQ. 29) Q(:) = Q29(:)
       IF (DaysInMon .EQ. 30) Q(:) = Q30(:)
       IF (DaysInMon .EQ. 31) Q(:) = Q31(:)
       EndOfQtr2 = Q(QtrNumber)
       RETURN
  801  ErrorMessage = 'Invalid parameter in routine EndOfQtr2(D,Q)'
       CALL PassMsg
       EndOfQtr2 = 0
       ErrorLevel = 1
       RETURN
       END FUNCTION EndOfQtr2

       !-------------------------------------------------------------
       INTEGER FUNCTION EndOfQtr3(Day, Month, Year)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Day, Month, Year
       INTEGER :: DD, DM, Q
       EndOfQtr3 = -1
       IF (Year .LT. 1)    GOTO 801
       IF (Year .GT. 2999) GOTO 801
       IF (Month .LT. 1)   GOTO 801
       IF (Month .GT. 12)  GOTO 801
       DD = DaysInMonth(Month, Year); IF (ErrorLevel .NE. 0) RETURN
       IF (Day .LT. 1)     GOTO 801
       IF (Day .GT. DD)    GOTO 801
       DM = DaysInMonth(Month, Year)      ; IF (ErrorLevel .NE. 0) RETURN
       Q  = QtrMonNumber(Day, Month, Year); IF (ErrorLevel .NE. 0) RETURN
       EndOfQtr3 = EndOfQtr2(DM, Q)       ; IF (ErrorLevel .NE. 0) RETURN
       RETURN

  801  ErrorMessage = 'Invalid parameter in routine EndOfQtr3(D,M,Y)'
       CALL PassMsg
       ErrorLevel = 1
       EndOfQtr3 = 0
       RETURN

       END FUNCTION EndOfQtr3




END MODULE GLERLUTIL





!-------------------------------------------------------------------------

