
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 :: 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
!
! 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

!
! 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
   CHARACTER (LEN=LEN(Line)) :: S

   UB = UBOUND(Args,1)

   !
   !  Total length of the line
   !
   TL = LEN_TRIM(Line)
   ArgC = 0                ! # of arguments found
   CP = 1                  ! Current position in Line
   DO WHILE (CP .LE. TL)
      DO WHILE ((Line(CP:CP) .EQ. ' ') .AND. (CP .LE. TL))
         CP = CP +1
      ENDDO
      IF (CP .LE. TL) THEN
         LS = CP        ! Left Side of argument
         RS = CP
         DO WHILE ((Line(CP:CP) .NE. ' ') .AND. (CP .LE. TL))
            RS = CP
            CP = CP + 1
         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

!-------------------------------------------------------------
!  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, '\', .TRUE.)     ! find last '\' 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. '\') FP = TRIM(FP) // '\'
     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. '\')  ) OK = .FALSE.
        IF (.NOT. OK) FP = ''
     END IF

     CALL Caps(FN); IF (ErrorLevel .NE. 0) GOTO 899
     CALL Caps(FP); IF (ErrorLevel .NE. 0) GOTO 899

     RETURN

 899 ErrorMessage = '[traceback] : ProcessPathAndFileName'; CALL PassMsg
     RETURN

     END SUBROUTINE ProcessPathAndFileName
   
!-------------------------------------------------------------
   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
!-------------------------------------------------------------
   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
 899 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
      Day = SequenceNumber / 24                                                 !TECII20050112
      Hour = SequenceNumber - Day * 24 + 1                                      !TECII20050112
      CALL SequenceDate(Day, Month, Year, Day)                                  !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
      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

   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

   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, Seq2

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

   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

   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

   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

   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
   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

   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

   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

   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

   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

   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

   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 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
 812  ErrorMessage =  'Error reading '//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
 899  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

      CL = 'IF EXIST '//TRIM(Name2)//' DEL '//TRIM(Name2)//' > NUL'
      CALL SYSTEM(TRIM(CL))
      CL = 'REN '//TRIM(Name1)//' '//TRIM(Name2)//' > NUL'
      CALL SYSTEM(TRIM(CL))
      Success = .TRUE.
      END SUBROUTINE Rename_SYSTEM
!-----------------------------------------------------------------------------
      SUBROUTINE DeleteFile (FName)
!
!  This routine is used to delete a file in a "Fortran-standard" manner.
!
      IMPLICIT NONE
      INTEGER :: I, UNum
      LOGICAL :: Flag
      CHARACTER (LEN=*), INTENT(IN) :: FName

!
!  Does the file exist?  If not, then there is nothing to do.
!
      INQUIRE(FILE=TRIM(FName), EXIST=Flag)
      IF (.NOT. Flag) RETURN

!
!  Open the file, then close/delete it.
!
      UNum = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=UNum, FILE=TRIM(FName), STATUS='OLD', IOSTAT=I)
      CLOSE(UNum, STATUS='DELETE', IOSTAT=I)
      IF (I .NE. 0) THEN
          ErrorMessage = 'Error deleting '//TRIM(FName)
          GOTO 898
      END IF
      GOTO 999

 898  CALL PassMsg
 899  ErrorLevel = 1
 999  RETURN
      END SUBROUTINE DeleteFile
!-------------------------------------------------------------------------
!
!     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
      LOGICAL :: UnitInUse
      INQUIRE(UNIT=UNum, Opened=UnitInUse)
      UnitIsInUse = UnitInUse
      RETURN
      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 = Varval
      RETURN
      END SUBROUTINE Round
!-------------------------------------------------------------------------

!-----------------------------------------------------
!  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
       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
       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
       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
       StartOfQtr3 = 0
  899  ErrorLevel = 1
       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
       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)
       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 LastDayOfQtrMon(D,Q)'
       CALL PassMsg
       EndOfQtr2 = 0
  899  ErrorLevel = 1
       RETURN
       END FUNCTION EndOfQtr2

       !-------------------------------------------------------------
       INTEGER FUNCTION EndOfQtr3(Day, Month, Year)
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Day, Month, Year
       INTEGER :: DD, DM, Q
       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 LastDayOfQtrMon(D,M,Y)'
       CALL PassMsg
       EndOfQtr3 = 0
  899  ErrorLevel = 1
       RETURN
       END FUNCTION EndOfQtr3




END MODULE GLERLUTIL





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

