MODULE MyKinds
  INTEGER, PARAMETER :: INTEGER2 = SELECTED_INT_KIND(R=4)
  INTEGER, PARAMETER :: INTEGER4 = SELECTED_INT_KIND(R=8)
  INTEGER, PARAMETER :: REAL4    = SELECTED_REAL_KIND(P=6,R=37)
  INTEGER, PARAMETER :: REAL8    = SELECTED_REAL_KIND(P=15,R=100)
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
  INTEGER, PARAMETER   :: MaxOpenedFiles = 50
  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'/)

!-------------------------------------------------------------------------
   INTERFACE DayOfYear
       INTEGER FUNCTION DayOfYearFromSeq(Seq)
         IMPLICIT  NONE
         INTEGER, INTENT(IN) :: Seq
       END FUNCTION DayOfYearFromSeq
       INTEGER FUNCTION DayOfYearFromDMY(Dy, Mn, Yr)
         IMPLICIT  NONE
         INTEGER, INTENT(IN) :: Dy, Mn, Yr
       END FUNCTION DayOfYearFromDMY
   END INTERFACE DayOfYear

   INTERFACE FirstDayOfQtrMon
       INTEGER FUNCTION StartOfQtr2(DaysInMonth, QtrNumber)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: DaysInMonth, QtrNumber
       END FUNCTION StartOfQtr2
       INTEGER FUNCTION StartOfQtr3(Day, Month, Year)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: Day, Month, Year
       END FUNCTION StartOfQtr3
       INTEGER FUNCTION StartOfQtr1(Seq)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: Seq
       END FUNCTION StartOfQtr1
   END INTERFACE FirstDayOfQtrMon

   INTERFACE LastDayOfQtrMon
       INTEGER FUNCTION EndOfQtr2(Days, QtrNumber)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: Days, QtrNumber
       END FUNCTION EndOfQtr2
       INTEGER FUNCTION EndOfQtr3(Day, Month, Year)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: Day, Month, Year
       END FUNCTION EndOfQtr3
       INTEGER FUNCTION EndOfQtr1(Seq)
         IMPLICIT   NONE
         INTEGER, INTENT(IN) :: Seq
       END FUNCTION EndOfQtr1
   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

      ErrorLevel = 0
      !
      !  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

   ErrorLevel = 0
   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 Caps(S)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: S
   INTEGER   :: I, Offset

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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
!------------------------------------------------------------------------
   SUBROUTINE StripLeadingBlanks (String)
   IMPLICIT   NONE
   CHARACTER (LEN=*), INTENT(INOUT) :: String

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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
!-------------------------------------------------------------------------
   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

   ErrorLevel = 0
   IF (Year .LE. BaseYear) THEN
      ErrorMessage = 'Year .LE. BaseYear'
      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
   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

   ErrorLevel = 0
   SeqNum = SequenceNumber
   BY = BaseYear
   IF (SeqNum .LT. 0) THEN
      ErrorMessage = 'SequenceNumber <0 not allowed.'
      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
   END SUBROUTINE SequenceDate
!------------------------------------------------------------------------------
   INTEGER FUNCTION JulianDayToSeqNum(Year, JDay)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Year, JDay
   INTEGER             :: Seq

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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 DaysInMonth (Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) ::  Month, Year
   INTEGER ::  M1, Y1, Seq1, M2, Y2, Seq2

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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 QtrMonNumber (D, M, Y)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: D, M, Y
   INTEGER :: I, Days, Q

   ErrorLevel = 0
   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
!------------------------------------------------------------------------
   LOGICAL FUNCTION IsFirstDayOfQtrMon(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year
   INTEGER :: I, J
   LOGICAL :: Flag

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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
!------------------------------------------------------------------------
   INTEGER FUNCTION DayOfQtrMon(Day, Month, Year)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: Day, Month, Year

   ErrorLevel = 0
   DayOfQtrMon = Day - FirstDayOfQtrMon(Day, Month, Year) + 1

   END FUNCTION DayOfQtrMon
!-----------------------------------------------------------------------------
   INTEGER FUNCTION GetNumYears(SSeq, ESeq)
   IMPLICIT   NONE
   INTEGER, INTENT(IN) :: SSeq, ESeq
   INTEGER :: D1, M1, Y1, D2, M2, Y2

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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

   ErrorLevel = 0
   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
   ErrorLevel = 0
   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)
   Mn = Mn + 1
   IF (Mn .GT. 12) THEN
      Mn = Mn - 12
      Yr = Yr + 1
   ENDIF
   CALL DateSequence( 1, Mn, Yr, SeqNum)
   SeqNum = SeqNum - 1
   END SUBROUTINE AdjustToEndOfMonth
!-----------------------------------------------------------------------------
      SUBROUTINE RenameFile (Name1, Name2, Success)
      IMPLICIT NONE
      INTEGER, PARAMETER   :: BufSize = 256
      INTEGER              :: I, BR, IOS, UNum1, UNum2
      LOGICAL              :: Flag, Success
      CHARACTER (LEN=*)    :: Name1, Name2
      CHARACTER (LEN=1)    :: Ch, FileBuffer(BufSize)
      CHARACTER (LEN=120)  :: S

      ErrorLevel = 0
      Success = .FALSE.
!
!  Open the files
!
      UNum1 = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=UNum1, FILE=TRIM(Name1), STATUS='OLD', ACCESS='TRANSPARENT',   &
           FORM='UNFORMATTED', ERR=811)
      CALL FileWasOpened(UNum1); IF (ErrorLevel .NE. 0) RETURN

      UNum2 = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
      OPEN(UNIT=UNum2, FILE=TRIM(Name2), STATUS='OLD', ERR=10)
      CLOSE(UNum2, STATUS='DELETE')
  10  OPEN(UNIT=UNum2, FILE=TRIM(Name2), STATUS='NEW', ACCESS='TRANSPARENT',   &
           FORM='UNFORMATTED', 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
!
      BR = 0
      READ(UNum1, IOSTAT=IOS) Ch
      IF (IOS .EQ. 0) FileBuffer(1) = Ch
      DO WHILE (IOS .EQ. 0)
         BR = BR + 1
         IF (BR .EQ. BufSize) THEN
            WRITE(UNum2, ERR=823) (FileBuffer(I), I=1,BR)
            BR = 0
         END IF
         READ(UNum1, IOSTAT=IOS) Ch
         IF (IOS .EQ. 0) FileBuffer(BR+1) = Ch
      END DO
      WRITE(UNum2, ERR=823) (FileBuffer(I), I=1,BR)
      CLOSE(UNum1)
      CALL FileWasClosed(UNum1);      IF (ErrorLevel .NE. 0) RETURN
      CLOSE(UNum2)
      CALL FileWasClosed(UNum2);      IF (ErrorLevel .NE. 0) RETURN
!
!  Lahey LF95 (v5.x) responds with IOSTAT=80, corresponding to the error
!  "A direct access READ statement was executed over the end of file.",
!  when we try to read beyond EOF in a TRANSPARENT file.  So we'll handle 
!  this as a special case.  If any other compiler is used, this may
!  have to be verified/changed.
!
      IF (IOS .EQ. 80) IOS = -1

!
!  IOS should now be less than 0 (indicating end-of-file)
!  If it is, delete the old file because the new one is good.
!  If it is not, then revert to the old file because the copy failed.
!
      IF (IOS .LT. 0) THEN
         OPEN(UNIT=UNum1, FILE=TRIM(Name1), STATUS='OLD',                 &
              ACCESS='TRANSPARENT', FORM='UNFORMATTED')
         CLOSE(UNum1, STATUS='DELETE')
         Success = .TRUE.
         RETURN
      ELSE
         OPEN(UNIT=UNum2, FILE=TRIM(Name2), STATUS='OLD',                 &
              ACCESS='TRANSPARENT', FORM='UNFORMATTED')
         CLOSE(UNum2, STATUS='DELETE')
         CALL IOSTAT_MSG(IOS, S)
         ErrorMessage = 'File Error: '//TRIM(S)
         GOTO 898
      END IF
      RETURN
!
!  Error while writing
!
 811  ErrorMessage =  'Error opening '//TRIM(Name1)//' for rename.'
      CALL PassMsg;  GOTO 898
 821  ErrorMessage =  'Error opening '//TRIM(Name2)//' for rename.'
      CALL PassMsg;  GOTO 898
 823  ErrorMessage =  'Error writing to '//TRIM(Name2)//' for rename.'
      CALL PassMsg;  GOTO 898

 898  ErrorLevel = 1
 899  Success = .FALSE.

 999  RETURN

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

      ErrorLevel = 0
      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

      ErrorLevel = 0
!
!  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)
          CALL PassMsg
          ErrorLevel = 1
          RETURN
      END IF
      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
     INTEGER  :: UNum, IOS1, IOS2 
     LOGICAL  :: InUse
      
     ErrorLevel = 0
     UNum = GetFreeUnitNumber(); IF (ErrorLevel .NE. 0) RETURN
     OPEN (UNIT=UNum, FILE='CANCEL.INT', STATUS='OLD', ERR=999)

     CLOSE (UNum, IOSTAT=IOS2)
     ErrorMessage = 'User has requested that the procedure be cancelled.'
     CALL PassMsg
     ErrorLevel = -99
     UserWantsToCancel = .TRUE.
     RETURN

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

      ErrorLevel = 0
      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=4)   ::  SNum

      ErrorLevel = 0
      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!'
        CALL PassMsg
        ErrorLevel = 1
        RETURN
      END IF
      IF (OpenedFiles .EQ. MaxOpenedFiles) THEN
        ErrorMessage = 'Programmed limit on number of open files was exceeded!'
        CALL PassMsg
        ErrorLevel = 1
        RETURN
      END IF
      OpenedFiles = OpenedFiles + 1
      OpenedFileUnits(OpenedFiles) = UNum
      END SUBROUTINE FileWasOpened
!-------------------------------------------------------------------------
      SUBROUTINE FileWasClosed(UNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) ::  UNum
      INTEGER             ::  I, J

      ErrorLevel = 0
      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
      INTEGER             ::  I, J

      ErrorLevel = 0
      J = -1
      DO I = 1, OpenedFiles
         IF (OpenedFileUnits(I) .EQ. UNum) J = I
      END DO
      IF (J .GE. 0) THEN
         FileIsOpen = .TRUE.
      ELSE
         FileIsOpen = .FALSE.
      END IF
      END FUNCTION FileIsOpen
!-------------------------------------------------------------------------
      SUBROUTINE CloseAllFiles()
      IMPLICIT   NONE
      INTEGER  ::  I, J, K, IOS

      ErrorLevel = 0
      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
      LOGICAL :: TheUnitIsInUse

      UNum = 200                ! start at 200 so first test will be on unit=201
      TheUnitIsInUse = .TRUE.   ! initial value to force loop traversal
      DO WHILE (TheUnitIsInUse .AND. (UNum .LT. 399))
         UNum = UNum + 1
         INQUIRE(UNIT=UNum, Opened=TheUnitIsInUse)
      END DO
      IF (UNum .GE. 399) THEN
         ErrorMessage = 'Unable to get available unit number'
         ErrorLevel = 1
         GetFreeUnitNumber = 9999
         RETURN
      END IF
      GetFreeUnitNumber = UNum
      END FUNCTION GetFreeUnitNumber
!-------------------------------------------------------------------------
      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!
!
      ErrorLevel = 0
      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
!-------------------------------------------------------------------------
END MODULE GLERLUTIL





!-----------------------------------------------------
!  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)
       USE GLERLUTIL
       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)
       USE GLERLUTIL
       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, int)      will use StartOfQtr2
!  I = FirstDayOfQtrMon(int, int, int) will use StartOfQtr3
!  I = FirstDayOfQtrMon(int)           will use StartOfQtr1
!
       INTEGER FUNCTION StartOfQtr2(Days, QtrNumber)
       USE GLERLUTIL
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Days, QtrNumber
       INTEGER :: D1, 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)
       USE GLERLUTIL
       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

       !-------------------------------------------------------------
       INTEGER FUNCTION StartOfQtr1(Seq)
       USE GLERLUTIL
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Seq
       INTEGER :: Dy, Mn, Yr, DM, Q
       CALL SequenceDate(Dy, Mn, Yr, Seq)   ; IF (ErrorLevel .NE. 0) RETURN
       StartOfQtr1 = StartOfQtr3(Dy, Mn, Yr); IF (ErrorLevel .NE. 0) RETURN
       END FUNCTION StartOfQtr1

!-----------------------------------------------------
!  These are the routines referenced in INTERFACE LastDayOfQtrMon
!
!  I = LastDayOfQtrMon(int, int)      will use EndOfQtr2
!  I = LastDayOfQtrMon(int, int, int) will use EndOfQtr3
!  I = LastDayOfQtrMon(int)           will use EndOfQtr1
!
       INTEGER FUNCTION EndOfQtr2(Days, QtrNumber)
       USE GLERLUTIL
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Days, QtrNumber
       INTEGER :: D1, Q(4)
       IF (QtrNumber .LT. 1) GOTO 801
       IF (QtrNumber .GT. 4) GOTO 801
       IF (Days .LT. 28)     GOTO 801
       IF (Days .GT. 31)     GOTO 801
       IF (Days .EQ. 28) Q(:) = Q28(:)
       IF (Days .EQ. 29) Q(:) = Q29(:)
       IF (Days .EQ. 30) Q(:) = Q30(:)
       IF (Days .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)
       USE GLERLUTIL
       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

       !-------------------------------------------------------------
       INTEGER FUNCTION EndOfQtr1(Seq)
       USE GLERLUTIL
       IMPLICIT   NONE
       INTEGER, INTENT(IN) :: Seq
       INTEGER :: Dy, Mn, Yr, DM, Q
       CALL SequenceDate(Dy, Mn, Yr, Seq) ; IF (ErrorLevel .NE. 0) RETURN
       EndOfQtr1 = EndOfQtr3(Dy, Mn, Yr)  ; IF (ErrorLevel .NE. 0) RETURN
       END FUNCTION EndOfQtr1

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

