!------------------------------------------------------------------------------
!     This program looks for an outlook weights file and uses appropriate
!     historical years of simulation with the weights to find the
!     corresponding probabilistic forecasts for each forecast variable.  It
!     then writes these forecasts for each forecast time interval (year, month, 
!     etc) for each forecast variable (Prec, Runoff, Evap, NBS, AirTemp, etc.) 
!     to a file, OTLKxxxx.PRN (or OTLKxxxx.MXD) where 
!     xxxx = YEAR, MNTH, QTMN, WKLY, DALY
!
!     Based on POTLKxxx.FOR programs.  Written in October, 2000 by Tim Hunter.
!
!     Latest modification : July 18, 2001 (TSH)
!
!------------------------------------------------------------------------------
!

MODULE POTLK_Subs

      USE FcstUtil
      USE ReadData

      REAL, DIMENSION(9), PARAMETER :: QntlPrcnt =                        &
     &     (/0.05, 0.10, 0.20, 0.30, 0.50, 0.70, 0.80, 0.90, 0.95/)

      CHARACTER (LEN=3)  :: Bsn
      LOGICAL            :: DoCMS

!
!  Set maximum number of each type of entry in the historic data array
!  Note that the historic data is only used to "backfill" to the beginning of
!  the specified forecast period (month, week, etc), so we will never have 
!  to go back more than 1 year.
!
      INTEGER, PARAMETER :: MaxHistYears = 1 
      INTEGER, PARAMETER :: MaxHistMons  = MaxHistYears * 12
      INTEGER, PARAMETER :: MaxHistQMons = MaxHistMons  * 4
      INTEGER, PARAMETER :: MaxHistWeeks = MaxHistYears * 53
      INTEGER, PARAMETER :: MaxHistDays  = MaxHistYears * 366

!
!  Set maximum number of each type of entry in the outlook data array
!
      INTEGER, PARAMETER :: MaxOtlkYears = 12
      INTEGER, PARAMETER :: MaxOtlkMons  = MaxOtlkYears * 12
      INTEGER, PARAMETER :: MaxOtlkQMons = MaxOtlkMons  * 4
      INTEGER, PARAMETER :: MaxOtlkWeeks = MaxOtlkYears * 53
      INTEGER, PARAMETER :: MaxOtlkDays  = MaxOtlkYears * 366

!
      INTEGER, PARAMETER :: MaxOtlks = 90        ! max # of outlook years (scenarios)
      INTEGER, PARAMETER :: DT       = 29        ! max # of data types in output
      INTEGER, PARAMETER :: LevelDT  = 5         ! # of data types in Level set
      INTEGER, PARAMETER :: MaxTotDays  = MaxHistDays + MaxOtlkDays

!
!  What type of value is output for each data type?  
!  Total         = 1
!  Average       = 2
!  End-of-period = 3
!
      INTEGER, PARAMETER, DIMENSION(DT) :: OutputType =     &
     &  (/ 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,     &
     &     2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2/)

!
!  Is the data allowed to be negative?  If not we will force all
!  negative values to zero.
!
      LOGICAL, PARAMETER, DIMENSION(DT) :: AllowNeg =                    &
     &  (/.FALSE., .FALSE.,  .TRUE.,  .TRUE.,  .TRUE.,                   &  ! run,prc,evp,nbs,air
     &    .FALSE.,  .TRUE., .FALSE., .FALSE., .FALSE.,                   &  ! wtp,lka,vap,wnd,cld
     &     .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,                   &  ! inc,rfl,nlw,lat,sen
     &     .TRUE.,  .TRUE., .FALSE., .FALSE., .FALSE.,                   &  ! nsf,ist,ice,hts,slm
     &    .FALSE., .FALSE., .FALSE., .FALSE., .FALSE.,                   &  ! grm,srf,snw,tlm,elv
     &    .FALSE., .FALSE., .FALSE.,  .TRUE./)                              ! mlv,inf,otf,tbs


      INTEGER, DIMENSION(MaxOtlks)  :: OtlkYr
      REAL,    DIMENSION(MaxOtlks)  :: OtlkWght

      INTEGER  :: DlyHistStart, DlyHistEnd, DlyOtlkStart, DlyOtlkEnd
      REAL, DIMENSION(DT, MaxHistDays)   :: DlyHist
      REAL, DIMENSION(DT, MaxOtlkDays)   :: DlyOtlk

!
!     This array will be dimensioned (DT, # of days/weeks/etc, # of outlooks[scenarios])
!
      REAL, DIMENSION(:,:,:), ALLOCATABLE :: OtlkData

!
      CHARACTER (LEN=15), DIMENSION(5), PARAMETER :: TimeStepString = &
     &   (/'daily          ', 'weekly         ', 'quarter-monthly',   &
     &     'monthly        ', 'annual         '/)

!
      CHARACTER (LEN=60), DIMENSION(DT) :: Hdr
      CHARACTER (LEN=20) :: TotHdr, AveHdr, EndHdr

      CHARACTER (LEN=45), DIMENSION(DT), PARAMETER :: HeaderLines =  &
     &   (/'Basin Runoff to Lake (mm)                    ',          &   ! Total
     &     'Over-Lake Precipitation (mm)                 ',          &   ! Total
     &     'Lake Evaporation (mm)                        ',          &   ! Total
     &     'Net Basin Supply to Lake (mm)                ',          &   ! Total
     &     'Over-Land Air Temperature (C)                ',          &   ! Average
     &     'Lake Surface Temperature (C)                 ',          &   ! Average
     &     'Over-Lake Air Temperature (C)                ',          &   ! Average
     &     'Over-Lake Vapor Pressure (mb)                ',          &   ! Average
     &     'Over-Lake Wind Speed (m/s)                   ',          &   ! Average
     &     'Over-Lake Cloud Cover (%)                    ',          &   ! Average
     &     'Lake Surface Incident SW Radiation (w/m2)    ',          &   ! Average
     &     'Lake Surface Reflection (w/m2)               ',          &   ! Average
     &     'Lake Surface Net Long Wave Radiation (w/m2)  ',          &   ! Average
     &     'Lake Surface Latent Heat Flux (w/m2)         ',          &   ! Average
     &     'Lake Surface Sensible Heat Flux (w/m2)       ',          &   ! Average
     &     'Lake Surface Net Surface Flux (w/m2)         ',          &   ! Average
     &     'Lake-Ice Surface Temperature (C)             ',          &   ! Average
     &     'Lake Ice Cover (%)                           ',          &   ! Average
     &     'Lake Heat Storage (cal/10e17)                ',          &   ! End-of-period
     &     'Basin Soil Moisture (cm)                     ',          &   ! End-of-period
     &     'Basin Groundwater Moisture (cm)              ',          &   ! End-of-period
     &     'Basin Surface Moisture (cm)                  ',          &   ! End-of-period
     &     'Basin Snow Pack (cm)                         ',          &   ! End-of-period
     &     'Basin Total Moisture (cm)                    ',          &   ! End-of-period
     &     'Lake Level (meters, IGLD85)                  ',          &   ! End-of-period
     &     'Lake Level (meters, IGLD85)                  ',          &   ! Average
     &     'Inflow (cms)                                 ',          &   ! Average
     &     'Outflow (cms)                                ',          &   ! Average
     &     'Total Basin Supply (cms)                     '/)             ! Average

      CHARACTER (LEN=45), DIMENSION(4), PARAMETER :: CMSHdrLines =   &
     &   (/'Basin Runoff to Lake (cms)                   ',          &   ! Total
     &     'Over-Lake Precipitation (cms)                ',          &   ! Total
     &     'Lake Evaporation (cms)                       ',          &   ! Total
     &     'Net Basin Supply to Lake (cms)               '/)             ! Total



CONTAINS

!------------------------------------------------------------------------
! SUBROUTINE HistTPc() reads the provisional met data for the
! specified dates.
!
! The Dat array is assumed to be dimensioned (DAYS,3) in calling procedure.
! The data passed back in the "Dat" array is in the following units:
!
!    Index  Data Type                   Units
!       1   Minimum Air Temperature     C
!       2   Maximum Air Temperature     C
!       3   Precipitation               mm
!
! Written by Tim Hunter 25Jul95
! Updated for Windows DLL by Tim Hunter  Oct, 2000
!------------------------------------------------------------------------
!
      SUBROUTINE HistTPc (SSeq, ESeq, Dat, Code)
      IMPLICIT NONE
      INTEGER          , INTENT(IN)    :: SSeq, ESeq
      REAL             , INTENT(INOUT) :: Dat(:,:)
      CHARACTER (LEN=4), INTENT(IN)    :: Code

      INTEGER :: I, J
      REAL, DIMENSION(MaxHistDays, 4) :: MData
      CHARACTER (LEN=3)  :: CSub

      Dat(:,:) = -9999.9      ! initialize entire array

!
!  Check for too many days specified
!
      IF (ESeq - SSeq + 1 .GT. MaxHistDays) THEN
         ErrorMessage = 'POUTLOOK: Too many days of historical data requested in HistTPc()'
         CALL PassMsg
         GOTO 898
      END IF

!
!  Construct file name parameters and call routine in ReadData module
!
      RD_FillMetMissing = .TRUE.
      CALL ReadMetData(SSeq, ESeq, MData, Bsn, Code, ThisLakeDir)
      IF (ErrorLevel .NE. 0) GOTO 899

!
!  Assign data from the MDat array to the Dat array
!
      DO I = 1, 3
         DO J = 1, ESeq-SSeq+1
            Dat(J,I) = MData(J,I)
         END DO
      END DO
      RETURN

 898  ErrorLevel = 1
 899  ErrorMessage = '[traceback] : HistTPc...'
      CALL PassMsg
      RETURN

      END SUBROUTINE HistTPc

!------------------------------------------------------------------------
! SUBROUTINE HistRun() reads the runoff and various soil moisture storages
! for the specified period.  The xxxALL.SUM file is used for this data.
!
! The Dat array is assumed to be dimensioned (DAYS,6) in calling procedure.
! The data passed back in the "Dat" array is in the following units:
!
!    Index  Data Type                   Units
!       1   Runoff                      cm over LAND surface
!       2   Upper Soil Zone Storage     cm over LAND surface
!       3   Lower Soil Zone Storage     cm over LAND surface
!       4   Ground Zone Storage         cm over LAND surface
!       5   Surface Zone Storage        cm over LAND surface
!       6   Snow Water Storage          cm over LAND surface
!
! Written by Tim Hunter
! Updated for Windows DLL by Tim Hunter  Oct, 2000
!---------------------------------------------------------------------------
!
      SUBROUTINE HistRun (SSeq, ESeq, Run)
      IMPLICIT NONE

      INTEGER, INTENT(IN)    :: SSeq, ESeq
      REAL   , INTENT(INOUT) :: Run(:,:)

      Run(:,:) = -9999.9      ! initialize entire array

!
!  How many days do we read
!
      IF (ESeq - SSeq + 1 .GT. MaxHistDays) THEN
         ErrorMessage = 'POUTLOOK: Too many days of historical data requested in HistRun()'
         CALL PassMsg
         GOTO 898
      END IF

!
!  Get data
!
      CALL ReadRunData(SSeq, ESeq, Run, Bsn, 'ALL', ThisLakeDir)
      IF (ErrorLevel .NE. 0) GOTO 899
      RETURN

 898  ErrorLevel = 1
 899  ErrorMessage = '[traceback] : HistRun...'
      CALL PassMsg
      RETURN

      END SUBROUTINE HistRun


!------------------------------------------------------------------------
! SUBROUTINE HistEvp() reads the overlake evaporation model output for the
! specified period.  The ZSEVAPPR.xxx file is used for this data.
!
! Note that item #12 is read from ZSEVAPPR.xxx as advection (correctly).
! We are not interested in advection, however, so we sum items 7-12
! (the heat flux terms) to compute net surface flux, which is then
! stored in Dat(12) for passing back to calling program.
!
! The Evp array is assumed to be dimensioned (DAYS,16) in calling procedure.
! The data passed back in the "Evp" array is in the following units:
!
!    Index  Data Type                   Units
!       1   Evaporation                 cm
!       2   Water Surface Temperature   C
!       3   Air Temperature             C
!       4   Vapor Pressure              millibars
!       5   Wind Speed                  meters/second
!       6   Cloud Cover                 decimal fraction (0-1.0)
!       7   Incident Short Wave         watts/square meter
!       8   Reflected Radiation         watts/square meter
!       9   Net Long Wave Flux          watts/square meter
!      10   Latent Heat Flux            watts/square meter
!      11   Sensible Heat Flux          watts/square meter
!      12   Net Surface Flux            watts/square meter
!      13   Ice Temperature             C
!      14   Ice Area                    decimal fraction (0-1.0)
!      15   Ice Depth                   meters
!      16   Heat In Storage             calories
!
!
! Written by Tim Hunter
! Updated for Windows DLL by Tim Hunter  Oct,2000
!--------------------------------------------------------------------------
!
      SUBROUTINE HistEvp (SSeq, ESeq, Evp)

      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: SSeq, ESeq
      REAL   , INTENT(INOUT) :: Evp(:,:)

      Evp(:,:) = -9999.9      ! initialize entire array

!
!  How many days do we need?
!
      
      IF (ESeq - SSeq + 1 .GT. MaxHistDays) THEN
         ErrorMessage = 'POUTLOOK: Too many days of historical data requested in HistEvp()'
         CALL PassMsg
         GOTO 898
      END IF

!
!  Get data
!
      CALL ReadEvapData(SSeq, ESeq, Evp, Bsn, ThisLakeDir)
      IF (ErrorLevel .NE. 0) GOTO 899

!
!  Adjust units on 2 data types from "%" to "decimal fraction"
!
      Evp(:,6)  = Evp(:,6)  / 100.
      Evp(:,14) = Evp(:,14) / 100.

      RETURN

  898 ErrorLevel = 1
  899 ErrorMessage = '[traceback] : HistEvp...'
      CALL PassMsg
      RETURN

      END SUBROUTINE HistEvp

!------------------------------------------------------------------------
! SUBROUTINE HistLandAir() reads the provisional met data for the
! specified dates to get the overland air temperature.
!
! The Dat array is assumed to be dimensioned (DAYS) in calling procedure.
! The data passed back in the "Dat" array is in degrees C:
!
! Written by Tim Hunter 19oct2000
!------------------------------------------------------------------------
!
      SUBROUTINE HistLandAir (SSeq, ESeq, Dat)
      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: SSeq, ESeq
      REAL   , INTENT(INOUT) :: Dat(:)

      INTEGER :: I
      REAL    :: T1, T2
      REAL, DIMENSION(MaxHistDays, 3) :: MData

      Dat(:) = -9999.9      ! initialize entire array

!
!  Check for too many days specified
!
      IF (ESeq - SSeq + 1 .GT. MaxHistDays) THEN
         ErrorMessage = 'POUTLOOK: Too many days of historical data requested in HistLandAir()'
         CALL PassMsg
         GOTO 898
      END IF

!
!  Construct file name parameters and call routine in ReadData module
!
      RD_FillMetMissing = .TRUE.
      CALL ReadLandMet(SSeq, ESeq, MData, Bsn, ThisLakeDir)
      IF (ErrorLevel .NE. 0) GOTO 899

!
!  Assign data from the MData array to the Dat array
!
      DO I = 1, ESeq-SSeq+1
         T1 = MData(I,1)
         T2 = MData(I,2)
         IF ((T1 .GT. -99.98) .AND. (T2 .GT. -99.98)) THEN
            Dat(I) = (T1 + T2) / 2.0
         ELSE
            Dat(I) = -9999.9
         END IF
      END DO
      RETURN

 898  ErrorLevel = 1
 899  ErrorMessage = '[traceback] : HistLandAir...'
      CALL PassMsg
      RETURN

      END SUBROUTINE HistLandAir

!------------------------------------------------------------------------
      SUBROUTINE ComputeAnn(InStrt, OutStrt, OutEnd, OtlkNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) :: InStrt, OutStrt, OutEnd, OtlkNum

      INTEGER  :: I, J, K, Yr, Day, Month, Year, Cnt
      LOGICAL  :: Flag
      REAL     :: DlyVal, Tot

      DO K = 1, DT
         Tot = 0.0
         Cnt = 0
         Yr = 1
         DO I = OutStrt, OutEnd
            IF (I .LT. InStrt) DlyVal = DlyHist(K, I-DlyHistStart+1)
            IF (I .GE. InStrt) DlyVal = DlyOtlk(K, I-DlyOtlkStart+1)
            IF (DlyVal .GT. -9998) THEN
               Tot = Tot + DlyVal
               Cnt = Cnt + 1
            END IF

            CALL SequenceDate(Day, Month, Year, I); IF (ErrorLevel .NE. 0) GOTO 899
            Flag = (Day .EQ. 31) .AND. (Month .EQ. 12)

            IF (Flag) THEN
               IF (OutputType(K) .EQ. 1) OtlkData(K,Yr,OtlkNum) = Tot
               IF (OutputType(K) .EQ. 2) OtlkData(K,Yr,OtlkNum) = Tot / Cnt
               IF (OutputType(K) .EQ. 3) OtlkData(K,Yr,OtlkNum) = DlyVal

               IF (DoCMS .AND. K .LE. 4) OtlkData(K,Yr,OtlkNum) = Tot / Cnt

               Tot = 0.0
               Cnt = 0
               Yr = Yr + 1
            END IF
         END DO
      END DO
      RETURN

  898 ErrorLevel = 1
  899 ErrorMessage = '[traceback] : ComputeAnn...'
      CALL PassMsg
      RETURN

      END SUBROUTINE ComputeAnn

!------------------------------------------------------------------------
      SUBROUTINE ComputeMon(InStrt, OutStrt, OutEnd, OtlkNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) :: InStrt, OutStrt, OutEnd, OtlkNum

      INTEGER  :: I, J, K, M, Day, Month, Year, Cnt
      LOGICAL  :: Flag
      REAL     :: DlyVal, Tot

      DO K = 1, DT
         Tot = 0.0
         Cnt = 0
         M = 1
         DO I = OutStrt, OutEnd
            IF (I .LT. InStrt) DlyVal = DlyHist(K, I-DlyHistStart+1)
            IF (I .GE. InStrt) DlyVal = DlyOtlk(K, I-DlyOtlkStart+1)
            IF (DlyVal .GT. -9998) THEN
               Tot = Tot + DlyVal
               Cnt = Cnt + 1
            END IF

            CALL SequenceDate(Day, Month, Year, I);    IF (ErrorLevel .NE. 0) GOTO 899
            Flag = IsLastDayOfMonth(Day, Month, Year); IF (ErrorLevel .NE. 0) GOTO 899

            IF (Flag) THEN
               IF (OutputType(K) .EQ. 1) OtlkData(K,M,OtlkNum) = Tot
               IF (OutputType(K) .EQ. 2) OtlkData(K,M,OtlkNum) = Tot / Cnt
               IF (OutputType(K) .EQ. 3) OtlkData(K,M,OtlkNum) = DlyVal

               IF (DoCMS .AND. K .LE. 4) OtlkData(K,M,OtlkNum) = Tot / Cnt

               Tot = 0.0
               Cnt = 0
               M = M + 1
            END IF
         END DO
      END DO
      RETURN

  898 ErrorLevel = 1
  899 ErrorMessage = '[traceback] : ComputeMon...'
      CALL PassMsg
      RETURN

      END SUBROUTINE ComputeMon


!------------------------------------------------------------------------
      SUBROUTINE ComputeQmn(InStrt, OutStrt, OutEnd, OtlkNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) :: InStrt, OutStrt, OutEnd, OtlkNum

      INTEGER  :: I, J, K, Q, Day, Month, Year, Cnt
      LOGICAL  :: Flag
      REAL     :: DlyVal, Tot

      DO K = 1, DT
         Tot = 0.0
         Cnt = 0
         Q = 1
         DO I = OutStrt, OutEnd
            IF (I .LT. InStrt) DlyVal = DlyHist(K, I-DlyHistStart+1)
            IF (I .GE. InStrt) DlyVal = DlyOtlk(K, I-DlyOtlkStart+1)
            IF (DlyVal .GT. -9998) THEN
               Tot = Tot + DlyVal
               Cnt = Cnt + 1
            END IF

            CALL SequenceDate(Day, Month, Year, I);     IF (ErrorLevel .NE. 0) GOTO 899
            Flag = IsLastDayOfQtrMon(Day, Month, Year); IF (ErrorLevel .NE. 0) GOTO 899

            IF (Flag) THEN
               IF (OutputType(K) .EQ. 1) OtlkData(K,Q,OtlkNum) = Tot
               IF (OutputType(K) .EQ. 2) OtlkData(K,Q,OtlkNum) = Tot / Cnt
               IF (OutputType(K) .EQ. 3) OtlkData(K,Q,OtlkNum) = DlyVal

               IF (DoCMS .AND. K .LE. 4) OtlkData(K,Q,OtlkNum) = Tot / Cnt

               Tot = 0.0
               Cnt = 0
               Q = Q + 1
            END IF
         END DO
      END DO
      RETURN

  898 ErrorLevel = 1
  899 ErrorMessage = '[traceback] : ComputeQmn...'
      CALL PassMsg
      RETURN

      END SUBROUTINE ComputeQmn

!------------------------------------------------------------------------
      SUBROUTINE ComputeWkl(InStrt, OutStrt, OutEnd, OtlkNum)
      IMPLICIT   NONE
      INTEGER, INTENT(IN) :: InStrt, OutStrt, OutEnd, OtlkNum

      INTEGER  :: I, J, K, W, Days, Cnt
      LOGICAL  :: Flag
      REAL     :: DlyVal, Tot

      DO K = 1, DT
         Tot = 0.0
         Cnt = 0
         W = 1
         Days = 0
         DO I = OutStrt, OutEnd
            Days = Days + 1
            IF (I .LT. InStrt) DlyVal = DlyHist(K, I-DlyHistStart+1)
            IF (I .GE. InStrt) DlyVal = DlyOtlk(K, I-DlyOtlkStart+1)
            IF (DlyVal .GT. -9998) THEN
               Tot = Tot + DlyVal
               Cnt = Cnt + 1
            END IF

            IF (Days .EQ. 7) THEN
               IF (OutputType(K) .EQ. 1) OtlkData(K,W,OtlkNum) = Tot
               IF (OutputType(K) .EQ. 2) OtlkData(K,W,OtlkNum) = Tot / Cnt
               IF (OutputType(K) .EQ. 3) OtlkData(K,W,OtlkNum) = DlyVal

               IF (DoCMS .AND. K .LE. 4) OtlkData(K,W,OtlkNum) = Tot / Cnt

               Tot = 0.0
               Cnt = 0
               W = W + 1
               Days = 0
            END IF
         END DO
      END DO
      RETURN

      END SUBROUTINE ComputeWkl


!------------------------------------------------------------------------
      SUBROUTINE ComputeDly(InStrt, OutStrt, OutEnd, OtlkNum)
      IMPLICIT   NONE

      INTEGER, INTENT(IN) :: InStrt, OutStrt, OutEnd, OtlkNum

      INTEGER  :: I, K, D
      REAL     :: DlyVal

      DO K = 1, DT
         D = 0
         DO I = OutStrt, OutEnd
            D = D + 1
            IF (I .LT. InStrt) DlyVal = DlyHist(K, I-DlyHistStart+1)
            IF (I .GE. InStrt) DlyVal = DlyOtlk(K, I-DlyOtlkStart+1)
            OtlkData(K,D,OtlkNum) = DlyVal
         END DO
      END DO
      RETURN

      END SUBROUTINE ComputeDly


!------------------------------------------------------------------------
      LOGICAL FUNCTION GetOtlkWghts (Ext, NumYrs)
!
!     Routine to input the outlook weights from file OTLKWGTS.xxx.
!
      IMPLICIT NONE
      CHARACTER (LEN=3), INTENT(IN) :: Ext
      INTEGER, INTENT(OUT) :: NumYrs

      INTEGER :: K, L, U1, IOS, Yr
      REAL    :: Wt
      CHARACTER (LEN=150) :: FileName

      FileName = TRIM(ThisLakeDir) // 'OTLKWGTS.' // Ext
      U1 = GetFreeUnitNumber();  IF (ErrorLevel .NE. 0) GOTO 899
      OPEN(UNIT=U1, FILE=TRIM(FileName), STATUS='OLD', ERR=811)
      CALL FileWasOpened(U1); IF (ErrorLevel .NE. 0) GOTO 899

      READ(U1, *, ERR=812)
      READ(U1, *, ERR=812)

      K = 0
      READ(U1, 9192, IOSTAT=IOS) Yr, Wt
      DO WHILE ((IOS .EQ. 0) .AND. (K .LT. MaxOtlks))
         IF ((Yr .GE. 1000) .AND. (Yr .LE. 2999)) THEN
            K = K + 1
            OtlkYr(K)   = Yr
            OtlkWght(K) = Wt
         END IF
         READ(U1, 9192, IOSTAT=IOS) Yr, Wt
      END DO
      CLOSE (U1)
      CALL FileWasClosed(U1); IF (ErrorLevel .NE. 0) GOTO 899

      NumYrs = K
      GetOtlkWghts = .TRUE.
      RETURN

 811  ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(FileName)
      CALL PassMsg;  GOTO 898
 812  ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(FileName)
      CALL PassMsg;  GOTO 898

 898  GetOtlkWghts = .FALSE.
      ErrorLevel = 1
 899  ErrorMessage = '[traceback] : GetOtlkWghts...'
      CALL PassMsg
      RETURN

 9190 FORMAT(24X, I3, I5)
 9191 FORMAT(32X, A280)
 9192 FORMAT(I6, F10.6)

      END FUNCTION GetOtlkWghts

!------------------------------------------------------------------------
!     This routine sorts the values in array A from smallest to largest and
!     also arranges the corresponding values in array B in the same order.
!     Thus, B is not sorted based on its own contents but rather by the 
!     contents of A.  Each element of B just "tags along" with it's partner
!     element in A and the final state of B will, in general, appear to
!     be unsorted.
!
      SUBROUTINE SortTwo (A, B, Number)
      IMPLICIT NONE
      REAL   , INTENT(INOUT) :: A(:)
      INTEGER, INTENT(INOUT) :: B(:), Number

      INTEGER ::  I, J, K, L, M, P
      REAL    ::  X

      P = Number
      DO WHILE (P .GT. 0)
        K = Number - P
        J = 1
        DO WHILE (J .LE. K)
          I = J
          M = I + P
          DO WHILE ((I .GT. 0) .AND. (A(I) .GT. A(M)))
            X = A(I)
            A(I) = A(M)
            A(M) = X

            L = B(I)
            B(I) = B(M)
            B(M) = L

            M = I
            I = I - P
          END DO
          J = J + 1
        END DO
        P = P / 2
      END DO
      RETURN

      END SUBROUTINE SortTwo

!----------------------------------------------------------------------
      REAL FUNCTION MM2CMS(Value, Area, Seconds)
      IMPLICIT  NONE
      INTEGER, INTENT(IN) :: Seconds
      REAL,    INTENT(IN) :: Value, Area
      REAL :: Val

      Val = Value / 1000.              ! mm -> meters
      Val = Val * Area / Seconds       ! meters -> cu meters/sec
      MM2CMS = Val

      RETURN
      END FUNCTION MM2CMS



END MODULE POTLK_Subs

!=========================================================================
!=========================================================================

MODULE POUTLOOK_Main

      USE POTLK_Subs

CONTAINS


!-------------------------------------------------------------------------
! This is the main processing module.  It takes 3 parameters:
!
! 1) ErrStatus is an integer (4-byte) that is passed back to the calling
!    procedure.  A zero indicates no problems, any other value indicates
!    a problem.  Look through the code for specifics.
!
! 2) HandleIn is an integer (4-byte) which is actually a Windows handle
!    for a control in the GUI (usually an invisible edit box) which will
!    accept a Windows API SetWindowTextA() call.  Any error messages are
!    passed back to the GUI program this way because there is no way to
!    pass back a string from a Fortran DLL to a Delphi GUI program (at 
!    least not with the Lahey LF95 v5.5 Fortran compiler).
!
! 3) The character string array is used to signal how the data is to be 
!    processed.  Each entry is case-insensitive and interpreted as follows:
!     
!      (1) Time-interval.  We look for one of the following values:
!                'YEAR', 'MONTH', 'QTRMONTH', 'WEEK', 'DAY'
!          If we fail to find any of these then we cannot continue.
!
!      (2) Lake level indicator.  We look for either "MIXED" or "LEVEL".
!          If either is there then we need to do lake level stuff and we
!          will read the weights from OTLKWGTS.MXD rather than OTLKWGTS.xxx
!          The variable DoMixed will be used as our flag for this.
!
!      (3) Data units indicator.  We look for: 'CMS'.  
!          If we find it then we will output the first 4 data types in 
!          cubic meters per second rather than a depth over the lake surface.
!
!      (4) 3 character lake name.  'SUP', 'MIC', etc.
!
!      (5) If present, this entry indicates the status of "QuietMode".
!          Default value is .FALSE., meaning that all messages will be written.
!          A value of .TRUE. means that status-type messages (progress %, etc)
!          will be suppressed (quiet).  Error messages will still be written.
!          The following values of this string will set QuietMode to .TRUE.:
!             "QUIET", "YES"
! 
!--------------------------------------------------------------------------
!
      SUBROUTINE DO_POUTLOOK(ErrStatus, HandleIn, StringArray)

      IMPLICIT NONE

      INTEGER, INTENT(INOUT) :: ErrStatus, HandleIn
      CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: StringArray

      INTEGER (KIND=INTEGER2) :: Dy, Mn, Yr
      INTEGER :: I, J, K, L, Q, IOS, Subs, Day, Month, Year, Mon, Seq1, Seq2
      INTEGER :: FcLen, FcLenYrs, FcDay, FcMon, FcYear, FcStrt, FcEnd
      INTEGER :: LBRMFcs, EVAPFcs, ComputedFcstEnd, YrIdx, RNum, NumSimYears
      INTEGER :: OutLks, OtlkNum, LakeNum, PrvYr, PrvMn, NumDays
      INTEGER :: DTtoPrint, MonIdx, OutStart, OutEnd, M1, D2, M2, Y2
      INTEGER :: TimeInt, OutLen, Ndx, SeqStart, SeqEnd, Seq, PercentDone
      INTEGER :: LSeq1, LSeq2, SA_UBound

      LOGICAL :: OK, DoLevels, DoMixed, DoDebug
      LOGICAL :: OtlkDataWasAllocated

      REAL :: Precip, Runoff, Evap, NBS, StrdHt, RDummy
      REAL :: Area, LandArea, LakeArea, LandToLake, R4
      REAL :: ConvFact, Seconds, Tmn, Tmx, Lev, IFlw, OFlw, TBS, TVal

      INTEGER, DIMENSION(MaxNoYears) :: SimYears
      INTEGER, DIMENSION(MaxOtlks)   :: B

      REAL, DIMENSION(4)         :: Totals
      REAL, DIMENSION(9)         :: X
      REAL, DIMENSION(11)        :: AverageSurfaceArea
      REAL, DIMENSION(14)        :: Z
      REAL, DIMENSION(MaxOtlks)  :: A, Y
      REAL, DIMENSION(MaxHistDays) :: LevArr, HDlyLdAir
      REAL, DIMENSION(MaxHistDays,  3)   :: HDlyTPc
      REAL, DIMENSION(MaxHistDays,  4)   :: HDlyLFT
      REAL, DIMENSION(MaxHistDays,  6)   :: HDlyRun
      REAL, DIMENSION(MaxHistDays, 16)   :: HDlyEvp

      CHARACTER (LEN= 1) :: Slash, Dash
      CHARACTER (LEN= 3) :: Ext, AbrN(11), AMon(12)
      CHARACTER (LEN= 4) :: CYear, PrcSrc
      CHARACTER (LEN=10) :: DD, NumFormat
      CHARACTER (LEN=20) :: S, FileName
      CHARACTER (LEN=25) :: Column1
      CHARACTER (LEN=60) :: OutputHeaderLines(DT)
      CHARACTER (LEN=80) :: FormatStr
      CHARACTER (LEN=99) :: File11, File21, File31, File41, File51,       &
     &                      File61, File71, File75, File81, File85
      CHARACTER (LEN=280) :: Line

      REAL              :: DbgVal(12,31)
      CHARACTER (LEN=8) :: DbgOut(12,31)

      WinHandle = HandleIn
      ErrorLevel = 0
      CALL ClearFilesOpen()
      Slash = '/'
      Dash  = '-'

      OtlkDataWasAllocated = .FALSE.
      DoDebug = .FALSE.
!      DoDebug = .TRUE.

      IF (DoDebug) THEN
        I = UBOUND(StringArray, 1)
        DO J = 1, I
           WRITE(ErrorMessage, 8462) J, TRIM(StringArray(J))
           CALL PassMsg
        END DO
 8462   FORMAT(' StringArray(', I0, ')=[', A, ']')
      END IF

!
!     How many entries are in StringArray?
!
      SA_UBound = UBOUND(StringArray, 1)

!
!     Parse StringArray() for the time-interval designation. 
!     Look for: 'YEAR', 'MONTH', 'QTRMONTH', 'WEEK', or 'DAY'
!     (case insensitive).  That will tell us the time-interval.
!     If we fail to find any of these then we cannot continue.
!
!     p.s.  Note that 'MONTH' is a substring of 'QTRMONTH'.  We
!           will structure the test so that is handled correctly.
!
      TimeInt = 0
      DO I = 1, SA_UBound
         Line = TRIM(StringArray(I))
         CALL Caps(Line); IF (ErrorLevel .NE. 0) GOTO 899
         IF (INDEX(Line, 'YEAR'    ) .GT. 0) TimeInt = 5
         IF (INDEX(Line, 'MONTH'   ) .GT. 0) TimeInt = 4
         IF (INDEX(Line, 'QTRMONTH') .GT. 0) TimeInt = 3     ! must follow test for "MONTH"
         IF (INDEX(Line, 'WEEK'    ) .GT. 0) TimeInt = 2
         IF (INDEX(Line, 'DAY'     ) .GT. 0) TimeInt = 1
         IF (TimeInt .EQ. 0) THEN
            ErrorMessage = 'POUTLOOK: No time interval was specified!'
            CALL PassMsg
            GOTO 898
         END IF
      END DO

!
!     Parse StringArray() for the lake level indicator. 
!     Look for either "MIXED" or "LEVEL". That will tell us if 
!     we need to do lake level stuff.  If so, we will read the 
!     weights from OTLKWGTS.MXD rather than OTLKWGTS.xxx
!     The variable DoMixed will be used as our flag for this.
!     If this string does not contain one of the 2 specified items
!     then we will not do lake level stuff.
!
      DoMixed = .FALSE.
      DO I = 1, SA_UBound
         Line = TRIM(StringArray(I))
         CALL Caps(Line); IF (ErrorLevel .NE. 0) GOTO 899
         IF (INDEX(Line, 'MIXED') .GT. 0) DoMixed = .TRUE.
         IF (INDEX(Line, 'LEVEL') .GT. 0) DoMixed = .TRUE.
      END DO

!
!     Parse StringArray() for 'CMS'.
!     If we find it, process the first 4 data types in cubic meters per second 
!     rather than as a depth.
!
      DoCMS = .FALSE.
      DO I = 1, SA_UBound
         Line = TRIM(StringArray(I))
         CALL Caps(Line); IF (ErrorLevel .NE. 0) GOTO 899
         IF (INDEX(Line, 'CMS') .GT. 0) DoCMS = .TRUE.
      END DO

      DO I = 1, DT
         OutputHeaderLines(I) = HeaderLines(I)
      END DO
      IF (DoCMS) THEN
         DO I = 1, 4
            OutputHeaderLines(I) = CMSHdrLines(I)
         END DO
      END IF

!
!  Find out which directory each lake is in.  Values are assigned to
!  the module array CfgDirs -- a 9-element character array -- as follows:
!    CfgDirs(1) = Lake Superior
!    CfgDirs(2) = Lake Michigan
!    CfgDirs(3) = Lake Huron
!    CfgDirs(4) = Georgian Bay
!    CfgDirs(5) = Lake StClair
!    CfgDirs(6) = Lake Erie
!    CfgDirs(7) = Lake Ontario
!    CfgDirs(8) = Lake Michigan-Huron
!    CfgDirs(9) = Level (CGLRRM stuff)
!
!  Each valid entry will end with the requisite (for directories) backslash.
!
      CALL ReadCfgFile('..\FORECAST.CFG')
      IF (ErrorLevel .NE. 0) GOTO 899

!
!  Make sure that there was an entry in FORECAST.CFG for the specified lake.
!  The variable ThisLakeDir will end with a backslash.
!
      S = '   '
      DO I = 1, SA_UBound
         Line = TRIM(StringArray(I))
         CALL Caps(Line); IF (ErrorLevel .NE. 0) GOTO 899
         DO J = 1, 8
            IF (LakeName3(J) .EQ. Line(1:3)) THEN
               S = LakeName3(J)
               ThisLakeDir = TRIM(CfgDirs(J))
               LakeNum = J
            END IF
         END DO
      END DO

      IF (S .EQ. '   ') THEN
         ErrorMessage = ' No lake specified when calling POUTLOOK.'
         CALL PassMsg
         GOTO 898
      ENDIF

      IF (ThisLakeDir .EQ. '') THEN
         ErrorMessage = ' No entry in FORECAST.CFG for '//S//'!'
         CALL PassMsg
         GOTO 898
      ENDIF

!
!     Did the user ask for QUIET MODE?
!     (QuietMode is a global variable in module FcstUtil)
!
      QuietMode = .FALSE.
      DO I = 1, SA_UBound
         Line = TRIM(ADJUSTL(StringArray(I)))
         CALL Caps(Line); IF (ErrorLevel .NE. 0) GOTO 899
         IF (Line(1:3) .EQ. 'QUIET') QuietMode = .TRUE.
      END DO

!
!  Write info messages to user.  While we are putting the text in variable
!  ErrorMessage, it is not an error.  This is just a convenient way
!  to handle writing out the text message.
!
      IF (.NOT. QuietMode) THEN
         IF (TimeInt .EQ. 5) ErrorMessage = 'Computing annual outlooks.'
         IF (TimeInt .EQ. 4) ErrorMessage = 'Computing monthly outlooks.'
         IF (TimeInt .EQ. 3) ErrorMessage = 'Computing qtr-monthly outlooks.'
         IF (TimeInt .EQ. 2) ErrorMessage = 'Computing weekly outlooks.'
         IF (TimeInt .EQ. 1) ErrorMessage = 'Computing daily outlooks.'
         CALL PassMsg

         PercentDone = 1
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     Read information from the SIMULATE file. 
!     If it is not present, no probabilistic outlook to do.
!
      File11 = TRIM(ThisLakeDir) // 'SIMULATE'
      INQUIRE(FILE=File11, EXIST=OK)
      IF (.NOT. OK) GOTO 811

      CALL ReadSIMULATEfile (Bsn, FcStrt, I, J, K, FcLen, NumSimYears, SimYears)

!
!     Verify validity of information and use it to fill in other variables
!     as needed.
!
      CALL Caps(Bsn); IF (ErrorLevel .NE. 0) GOTO 899
      I = 1
      DO WHILE (Bsn .NE. LakeName3(I))
        I = I + 1
        IF (I .GT. 11) THEN
          ErrorMessage = 'POUTLOOK: Error in lake name in file SIMULATE!'
          CALL PassMsg
          GOTO 898
        END IF
      END DO
      LakeNum = I
      CALL SequenceDate(FcDay, FcMon, FcYear, FcStrt); IF (ErrorLevel .NE. 0) GOTO 899

!
!     Convert forecast length from number of months to number of days.
!
      CALL SequenceDate(Day, Month, Year, FcStrt); IF (ErrorLevel .NE. 0) GOTO 899
      Month = Month + FcLen - 1
      IF (Day .NE. 1) Month = Month + 1
      DO WHILE (Month .GT. 12)
        Month = Month - 12
        Year = Year + 1
      END DO
      CALL DateSequence(28, Month, Year, ComputedFcstEnd); IF (ErrorLevel .NE. 0) GOTO 899
      CALL AdjustToEndOfMonth(ComputedFcstEnd); IF (ErrorLevel .NE. 0) GOTO 899

      I = ComputedFcstEnd - FcStrt + 1
      IF (I .GT. MaxOtlkDays) THEN
        WRITE(ErrorMessage, 9901)
        CALL PassMsg
        GOTO 898
      END IF

      IF (DoDebug) THEN
         ErrorMessage = 'Reading info from BSNNM, etc '; CALL PassMsg
      END IF

!
!     Read info from BSNNM, EBSNNM, and AREA files.
!
      File21 = TRIM(ThisLakeDir) // 'BSNNM'
      OPEN(UNIT=21, FILE=TRIM(File21), STATUS='OLD', RECL=12,              &
     &     ACCESS='DIRECT', FORM='FORMATTED', ERR=821)
      CALL FileWasOpened(21); IF (ErrorLevel .NE. 0) GOTO 899
      READ(21, 2101, REC=2, ERR=822) Subs, PrcSrc
      READ(21, 2102, REC=5, ERR=822) Day, Month, Year
      CALL DateSequence(Day, Month, Year, LBRMFcs); IF (ErrorLevel .NE. 0) GOTO 899
      READ(21, 2102, REC=6, ERR=822) Day, Month, Year
      CALL DateSequence(Day, Month, Year, FcEnd);   IF (ErrorLevel .NE. 0) GOTO 899
      CLOSE (21)
      CALL FileWasClosed(21); IF (ErrorLevel .NE. 0) GOTO 899

      IF (LBRMFcs .NE. FcStrt) THEN              ! Must be same as in SIMULATE!
        WRITE(ErrorMessage, 9907)
        CALL PassMsg
        CALL SequenceDate(Day, Month, Year, LBRMFcs); IF (ErrorLevel .NE. 0) GOTO 899
        WRITE(ErrorMessage, 9951) 'BSNNM start date = ', Day, MonthName3(Month), Year
        CALL PassMsg
        CALL SequenceDate(Day, Month, Year, FcStrt); IF (ErrorLevel .NE. 0) GOTO 899
        WRITE(ErrorMessage, 9951) 'SIMULATE start date = ', Day, MonthName3(Month), Year
        CALL PassMsg
        GOTO 898
      END IF

      IF (FcEnd .NE. ComputedFcstEnd) THEN       ! Must be same as in SIMULATE!
        WRITE(ErrorMessage, 9907)
        CALL PassMsg
        CALL SequenceDate(Day, Month, Year, FcEnd); IF (ErrorLevel .NE. 0) GOTO 899
        WRITE(ErrorMessage, 9951) 'BSNNM end date = ', Day, MonthName3(Month), Year
        CALL PassMsg
        CALL SequenceDate(Day, Month, Year, ComputedFcstEnd); IF (ErrorLevel .NE. 0) GOTO 899
        WRITE(ErrorMessage, 9951) 'SIMULATE end date = ', Day, MonthName3(Month), Year
        CALL PassMsg
        GOTO 898
      END IF

      File31 = TRIM(ThisLakeDir) // 'EBSNNM'
      OPEN(UNIT=31, FILE=TRIM(File31), STATUS='OLD', RECL=12,              &
     &     ACCESS='DIRECT', FORM='FORMATTED', ERR=831)
      CALL FileWasOpened(31); IF (ErrorLevel .NE. 0) GOTO 899
      READ(31, 3101, REC=5, ERR=832) Day, Month, Year
      CALL DateSequence(Day, Month, Year, EVAPFcs); IF (ErrorLevel .NE. 0) GOTO 899
      CLOSE (31)
      CALL FileWasClosed(31); IF (ErrorLevel .NE. 0) GOTO 899

      File41 = TRIM(ThisLakeDir) // 'AREA.' // Bsn
      OPEN(UNIT=41, FILE=TRIM(File41), STATUS='OLD', ERR=841)
      CALL FileWasOpened(41); IF (ErrorLevel .NE. 0) GOTO 899
      LandArea = 0.0
      DO K = 1, Subs
        READ(41, 4101, ERR=842) Area
        LandArea = LandArea + Area
      END DO
      CLOSE (41)
      CALL FileWasClosed(41); IF (ErrorLevel .NE. 0) GOTO 899

      LakeArea = DigitLakeArea(LakeNum)                            
      LandToLake = LandArea / LakeArea

      IF (DoDebug) THEN
         ErrorMessage = 'Verifying dates...'; CALL PassMsg
      END IF

!
!     Verify that the forecast start date for the evaporation forecast is the
!     same as the LBRM forecast start date (which has already been checked 
!     against the SIMULATE file).
!
      IF (LBRMFcs .NE. EVAPFcs) THEN
        WRITE(ErrorMessage, 9906)
        CALL PassMsg
        GOTO 898
      END IF

      PercentDone = 5
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     Assign module global variables for use in subroutines
!
      DlyOtlkStart = FcStrt
      DlyOtlkEnd   = FcEnd

!
!     Determine the dates for output.  That is, when is the start
!     of the first time-period for which we will output data and when is
!     the end of the last.  For the start this will be:
!
!     Yearly     = January 1 of the forecast start year.
!     Monthly    = The first day of the forecast start month.
!     QtrMonthly = The beginning of the qtr-month in which the forecast
!                      start date falls.  e.g. if the forecast start date
!                      is the 12th, then the output start date will be either
!                      the 8th or 9th (depending on which month it is).
!     Weekly     = The forecast start date (no backfill needed).
!     Daily      = The forecast start date (no backfill needed).
!
      IF (DoDebug) THEN
         ErrorMessage = 'Determining output dates...'; CALL PassMsg
      END IF

      SELECT CASE (TimeInt)
         CASE (5)    
             CALL SequenceDate(Day, Month, Year, FcStrt);   IF (ErrorLevel .NE. 0) GOTO 899
             CALL DateSequence(  1,     1, Year, OutStart); IF (ErrorLevel .NE. 0) GOTO 899
         CASE (4) 
             CALL SequenceDate(Day, Month, Year, FcStrt);   IF (ErrorLevel .NE. 0) GOTO 899
             CALL DateSequence(  1, Month, Year, OutStart); IF (ErrorLevel .NE. 0) GOTO 899
         CASE (3)
             CALL SequenceDate(Day, Month, Year, FcStrt);   IF (ErrorLevel .NE. 0) GOTO 899
             Day = FirstDayOfQtrMon(Day, Month, Year);      IF (ErrorLevel .NE. 0) GOTO 899
             CALL DateSequence(Day, Month, Year, OutStart); IF (ErrorLevel .NE. 0) GOTO 899
         CASE (1, 2)
             OutStart = FcStrt
      END SELECT

!
!     Now determine the output end date.  Since the forecast end date is
!     always forced to be the last day of a month we only have 3 
!     distinct cases (TimeInt value in parens):
!
!     (5) Yearly     = If the forecast ends on December 31, then it is 12/31 of the
!                      forecast end year.  Otherwise it's 12/31 of the prior year.
!     (4) Monthly    = The forecast end date.
!     (3) QtrMonthly = The forecast end date.
!     (2) Weekly     = The last day of the last *complete* week within the forecast period.
!     (1) Daily      = The forecast end date.
!
      SELECT CASE (TimeInt)
         CASE (5)
             CALL SequenceDate(Day, Month, Year, FcEnd); IF (ErrorLevel .NE. 0) GOTO 899
             OutEnd = FcEnd
             IF (Month .NE. 12)    &
     &          CALL DateSequence(31, 12, Year-1, OutEnd); IF (ErrorLevel .NE. 0) GOTO 899
         CASE (4, 3, 1)
             OutEnd = FcEnd
         CASE (2)
             I = (FcEnd - FcStrt + 1) / 7   ! integer division yields # of COMPLETE weeks
             J = FcStrt - 1 + I*7
      END SELECT

      IF (DoDebug) THEN
         WRITE(ErrorMessage, 3911) FcStrt, OutStart, FcEnd; CALL PassMsg
      END IF

!
!     Input outlook years and weights, if available.
!
!     The actual years (1951, 1952, etc) will be stored in the "module global"
!     variable OtlkYr and the weights for those years will be stored in the
!     "module global" variable OtlkWght.
!
!     The number of outlook years will be returned in variable Outlks.
!
      IF (DoDebug) THEN
         ErrorMessage = 'Reading outlook weights...'; CALL PassMsg
      END IF

      Ext = Bsn
      IF (DoMixed) Ext = 'MXD'
      OK = GetOtlkWghts(Ext, Outlks); IF (ErrorLevel .NE. 0) GOTO 899
      IF (.NOT. OK) THEN
         WRITE(ErrorMessage, 9908)
         CALL PassMsg
         GOTO 898
      ENDIF
      IF (Outlks .NE. NumSimYears) THEN
         File11 = TRIM(ThisLakeDir)//'SIMULATE'
         File21 = TRIM(ThisLakeDir)//'OTLKWGTS.'//Ext
         WRITE(ErrorMessage, 9909) TRIM(File11), TRIM(File21), NumSimYears, Outlks 
         CALL PassMsg
         GOTO 898
      END IF

!
!     Now that we know how many outlooks there are, we can allocate the
!     RAM for the output data
!
      IF (TimeInt .EQ. 5) OutLen = GetNumYears(OutStart, OutEnd)
      IF (TimeInt .EQ. 4) OutLen = GetNumMonths(OutStart, OutEnd)
      IF (TimeInt .EQ. 3) OutLen = GetNumQtrMons(OutStart, OutEnd)
      IF (TimeInt .EQ. 2) OutLen = GetNumWeeks(OutStart, OutEnd)
      IF (TimeInt .EQ. 1) OutLen = OutEnd - OutStart + 1

      IF (DoDebug) THEN
         ErrorMessage = 'Allocating RAM...'; CALL PassMsg
      END IF

      ALLOCATE(OtlkData(DT, OutLen, OutLks), STAT=IOS)
      IF (IOS .NE. 0) THEN
         ErrorMessage = 'POUTLOOK: Error while allocating RAM!'
         CALL PassMsg
         GOTO 898
      END IF
      OtlkDataWasAllocated = .TRUE.

      PercentDone = 10
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     Fill daily data array for the period from January 1 to the day before
!     the forecast start date.  This will be used to "backfill" from
!     the forecast start date to the beginning of whatever time interval
!     has been specified.  Data prior to the "OutStart" date will just be
!     -999 (missing) values.  Data on/after the "OutStart" date will be read
!     from the appropriate files.  
!
!     Originally I just read real data from January 1 to the forecast start 
!     date (minus 1), and if there is no missing data in the provisional
!     data set then this is a good solution.  However, filling in missing
!     met data values (the models do, so we need to do the same) turned out
!     to be a significant performance penalty.  So I added the code/logic
!     to minimize the reading of provisional data, thereby reducing the
!     chances of having to fill in missing data values.
!     e.g. if the missing data is in February and the forecast start date
!     is July 11, there is no reason to mess with that February data unless
!     we are computing annual values.
!
!     Accomplished by reading/storing data from "OutStart" to "Seq2".
!     The HDLYxxx arrays will start on the "OutStart" date.
!
!     The DlyHist array still begins on January 1 ("DlyHistStart") for 
!     coding simplicity.
!
      IF (.NOT. QuietMode) THEN
         ErrorMessage = '~B~Reading daily data prior to start of forecast...'
         CALL PassMsg
      END IF
      IF (DoDebug) THEN
         ErrorMessage = 'Reading daily data...'; CALL PassMsg
      END IF

      RD_FillMetMissing = .TRUE.   
      CALL DateSequence(    1,     1, FcYear, Seq1); IF (ErrorLevel .NE. 0) GOTO 899
      CALL DateSequence(FcDay, FcMon, FcYear, Seq2); IF (ErrorLevel .NE. 0) GOTO 899
      Seq2 = Seq2 - 1
      CALL HistTPc(OutStart, Seq2, HDlyTPc, PrcSrc); IF (ErrorLevel .NE. 0) GOTO 899

      PercentDone = 13
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

      CALL HistRun(OutStart, Seq2, HDlyRun);         IF (ErrorLevel .NE. 0) GOTO 899

      PercentDone = 16
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

      CALL HistEvp(OutStart, Seq2, HDlyEvp);         IF (ErrorLevel .NE. 0) GOTO 899

      PercentDone = 19
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

      CALL HistLandAir(OutStart, Seq2, HDlyLdAir);   IF (ErrorLevel .NE. 0) GOTO 899
      DlyHistStart = Seq1
      DlyHistEnd   = Seq2

      PercentDone = 22
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     Get values for inflow, outflow, level, TBS
!
      HDlyLFT(:,:) = -9999.9
      IF (DoMixed) THEN
         IF ((Bsn .EQ. 'MIC') .OR. (Bsn .EQ. 'HUR') .OR. (Bsn .EQ. 'GEO')) THEN
            File75 = TRIM(ThisLakeDir) // 'LFTMHUPR.INT'
         ELSE
            File75 = TRIM(ThisLakeDir) // 'LFT'//Bsn//'PR.INT'
         END IF
         OPEN(UNIT=75, FILE=TRIM(File75), STATUS='OLD', IOSTAT=IOS)
         IF (IOS .EQ. 0) THEN
            CALL FileWasOpened(75); IF (ErrorLevel .NE. 0) GOTO 899
            RNum = 1
            READ(75, *, ERR=877)
            READ(75, *, ERR=877)
            READ(75, 7501, ERR=877) Year, Mon, Day
            CALL DateSequence(Day, Mon, Year, LSeq1);  IF (ErrorLevel .NE. 0) GOTO 899
            READ(75, 7501, ERR=877) Year, Mon, Day
            CALL DateSequence(Day, Mon, Year, LSeq2);  IF (ErrorLevel .NE. 0) GOTO 899
            IF ((LSeq1 .GT. DlyHistStart) .OR. (LSeq2 .LT. DlyHistEnd)) THEN
               WRITE(ErrorMessage, 9904) TRIM(File75)
               CALL PassMsg
               GOTO 898
            ENDIF
            READ(75, *, ERR=877)     ! skip header line

            DO I = LSeq1, LSeq2
               READ(75, 7502, ERR=877) Lev, IFlw, OFlw, TBS
               IF ((I .GE. OutStart) .AND. (I .LE. DlyHistEnd)) THEN
                  Ndx = I - OutStart + 1
                  HDlyLFT(Ndx, 1) = Lev
                  HDlyLFT(Ndx, 2) = IFlw
                  HDlyLFT(Ndx, 3) = OFlw
                  HDlyLFT(Ndx, 4) = TBS / 100.  ! hundreds of CMS - see discussion later
               END IF
            ENDDO
            CLOSE (75)
            CALL FileWasClosed(75); IF (ErrorLevel .NE. 0) GOTO 899
         END IF
      END IF

      PercentDone = 25
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     Assign this data into a single array so that things are similar 
!     between the historical and outlook data arrays.  DlyHist is a 
!     "module global" variable in module POTLK_SUBS.
!     Note that runoff and evap have to be converted from cm to mm.
!     Precip, though, is already in mm.  Runoff also needs to be converted
!     from a depth over the land surface to a depth over the lake.
!
      IF (DoDebug) THEN
         ErrorMessage = 'Rearranging daily data...'; CALL PassMsg
      END IF

      DO I = Seq1, OutStart-1
        Ndx = I - Seq1 + 1
        DO J = 1, 29
           DlyHist(J,Ndx) = -9999.9
        END DO
      END DO

      DO I = OutStart, Seq2
         Ndx = I - Seq1 + 1
         J   = I - OutStart + 1
         DlyHist( 1,Ndx) = HDlyRun(J, 1) * 10.0 * LandToLake                 ! Run
         DlyHist( 2,Ndx) = HDlyTPc(J, 3)                                     ! Prc
         DlyHist( 3,Ndx) = HDlyEvp(J, 1) * 10.0                              ! Evp
         DlyHist( 4,Ndx) = DlyHist(1,Ndx) + DlyHist(2,Ndx) - DlyHist(3,Ndx)  ! NBS
         DlyHist( 5,Ndx) = HDlyLdAir(J)                                      ! overland Air Temp

         IF (DoCMS) THEN
            DO K = 1, 4
               TVal = DlyHist(K, Ndx)
               DlyHist(K,Ndx) = MM2CMS(TVal, LakeArea, 86400) 
            END DO
         END IF

         DlyHist( 6,Ndx) = HDlyEvp(J, 2)                                     ! WTemp
         DlyHist( 7,Ndx) = HDlyEvp(J, 3)                                     ! overlake air temp
         DlyHist( 8,Ndx) = HDlyEvp(J, 4)                                     ! vapor
         DlyHist( 9,Ndx) = HDlyEvp(J, 5)                                     ! wind
         DlyHist(10,Ndx) = HDlyEvp(J, 6) * 100.0                             ! cloud (fraction -> %)
         DlyHist(11,Ndx) = HDlyEvp(J, 7)                                     ! incident
         DlyHist(12,Ndx) = HDlyEvp(J, 8)                                     ! reflected
         DlyHist(13,Ndx) = HDlyEvp(J, 9)                                     ! Net LW
         DlyHist(14,Ndx) = HDlyEvp(J,10)                                     ! latent
         DlyHist(15,Ndx) = HDlyEvp(J,11)                                     ! sensible
         DlyHist(16,Ndx) = HDlyEvp(J,12)                                     ! net flux
         DlyHist(17,Ndx) = HDlyEvp(J,13)                                     ! ice temp
         DlyHist(18,Ndx) = HDlyEvp(J,14)                                     ! ice cover
         DlyHist(19,Ndx) = HDlyEvp(J,15)                                     ! heat sto

         DlyHist(20,Ndx) = HDlyRun(J, 2) + HDlyRun(J, 3)                     ! soil moist
         DlyHist(21,Ndx) = HDlyRun(J, 4)                                     ! gzm
         DlyHist(22,Ndx) = HDlyRun(J, 5)                                     ! surf
         DlyHist(23,Ndx) = HDlyRun(J, 6)                                     ! snow
         DlyHist(24,Ndx) = SUM(HDlyRun(J, 2:6))                              ! total moisture

         DlyHist(25,Ndx) = HDlyLFT(J, 1)                                     ! end-of-day level
         DlyHist(26,Ndx) = HDlyLFT(J, 1)                                     ! end-of-day level (again)
         DlyHist(27,Ndx) = HDlyLFT(J, 2)                                     ! inflow
         DlyHist(28,Ndx) = HDlyLFT(J, 3)                                     ! outflow
         DlyHist(29,Ndx) = HDlyLFT(J, 4)                                     ! total basin supply
      END DO

      PercentDone = 30
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

!
!     For each outlook year (scenario) ...
!
      IF (DoDebug) THEN
         ErrorMessage = 'Starting loop for outlooks...'; CALL PassMsg
      END IF

      DO OtlkNum = 1, OutLks
        WRITE(CYear, '(I4)') OtlkYr(OtlkNum)

        PercentDone = 30 + ((OtlkNum*100.0/OutLks) * 0.60)   ! 30..90
        IF (.NOT. QuietMode) THEN
           WRITE(ErrorMessage, 9011) PercentDone
           CALL PassMsg
        END IF

!
!       Get daily outlook data for the forecast period.  
!       In mm over the lake surface
!
!       (1) Runoff
!       (2) Precip
!       (3) Evap
!       (4) NBS
!       (5) Overland Air Temp  (degrees C)
!
        File51 = TRIM(ThisLakeDir) // 'DLYTBL' // CYear // '.INT'
        OPEN(UNIT=51, FILE=TRIM(File51), STATUS='OLD', RECL=24,           &
     &       ACCESS='DIRECT', FORM='UNFORMATTED', ERR=851)
        CALL FileWasOpened(51); IF (ErrorLevel .NE. 0) GOTO 899

        READ(51, REC=1, ERR=852) SeqStart, SeqEnd
        IF (SeqStart .NE. FcStrt .OR. SeqEnd .LT. FcEnd) THEN
           WRITE(ErrorMessage, 9927) TRIM(File51)
           CALL PassMsg
           GOTO 898
        ENDIF

        DO I = FcStrt, FcEnd
           Ndx = I - FcStrt + 1
           RNum = Ndx + 1          ! add 1 for the header record
           READ(51, REC=RNum, ERR=852) Tmn, Tmx, (Z(J), J=1,4)
           DO J = 1, 4
             IF (Z(J) .GT. -999.) THEN
               DlyOtlk(J, Ndx) = Z(J)
               IF (DoCMS) DlyOtlk(J, Ndx) = MM2CMS(Z(J), LakeArea, 86400) 
             END IF
           END DO
           DlyOtlk(5,Ndx) = (Tmn+Tmx) / 2.0
        END DO
        CLOSE(51)
        CALL FileWasClosed(51); IF (ErrorLevel .NE. 0) GOTO 899

!
!       (6) Water Temp
!       (7) Air Temp
!       (8) Vapor Pressure
!       (9) Wind Speed
!       (10) Cloud Cover
!       (11) ShortWave flux
!       (12) Reflection 
!       (13) Net LongWave
!       (14) Latent Heat flux
!       (15) Sensible Heat flux
!       (16) Net Total Heat flux  (assigned in place of advection)
!       (17) Ice Temp
!       (18) Ice Area
!       (19) Stored Heat (10**17 calories)
!
!       Note that while reading the file, the value in Z(11) is
!       advection, which we do not output.  We do, however, want to know
!       the net flux, which is the sum of items 6-11.  We then assign
!       the net flux in place of the advection in the array.
!
        File61 = TRIM(ThisLakeDir) // 'ESTOTL' // CYear // '.INT'
        OPEN(UNIT=61, FILE=TRIM(File61), STATUS='OLD', RECL=70,           &
     &       ACCESS='DIRECT', FORM='UNFORMATTED', ERR=861)
        CALL FileWasOpened(61); IF (ErrorLevel .NE. 0) GOTO 899

        READ(61, REC=1, ERR=862) Dy, Mn, Yr
        IF ((Dy .NE. FcDay) .OR. (Mn .NE. FcMon) .OR. (Yr .NE. FcYear)) THEN
          WRITE(ErrorMessage, 9905) TRIM(File61)
          CALL PassMsg
          GOTO 898
        END IF

        DO I = FcStrt, FcEnd
          Ndx = I - FcStrt + 1
          READ(61, REC=Ndx, ERR=862) Dy, Mn, Yr, R4, (Z(J),J=1,13), R4, StrdHt
          Z(5) = Z(5) * 100.

          R4 = 0.             ! compute the net flux
          DO J = 6, 11
             R4 = R4 + Z(J)
          END DO
          Z(11) = R4          ! overwrite advection with net flux

          Z(13) = Z(13) * 100.
          Z(14) = StrdHt / 1.E+17
          DO J = 6, 19
            IF (Z(J-5) .GT. -999.) THEN
              DlyOtlk(J, Ndx) = Z(J - 5)
            END IF
          END DO

          IF (DlyOtlk(18, Ndx) .LT. 0.005) DlyOtlk(17, Ndx) = 0.0    ! if no ice cover, ice temp = 0.0
        END DO
        CLOSE (61)
        CALL FileWasClosed(61); IF (ErrorLevel .NE. 0) GOTO 899

!
!       (20) Soil Moisture Storage
!       (21) Groundwater Moisture Storage
!       (22) Surface Moisture Storage
!       (23) Snowpack Moisture Storage
!       (24) Total Moisture Storage
!
        File71 = TRIM(ThisLakeDir) // 'STOOTL' // CYear // '.INT'
        OPEN(UNIT=71, FILE=TRIM(File71), STATUS='OLD', RECL=26,           &
     &       ACCESS='DIRECT', FORM='UNFORMATTED', ERR=871)
        CALL FileWasOpened(71); IF (ErrorLevel .NE. 0) GOTO 899

        READ(71, REC=1, ERR=872) Dy, Mn, Yr
        IF ((Dy .NE. FcDay) .OR. (Mn .NE. FcMon) .OR. (Yr .NE. FcYear)) THEN
           WRITE(ErrorMessage, 9905) TRIM(File71)
           CALL PassMsg
           GOTO 898
        END IF

        DO I = FcStrt, FcEnd
          Ndx = I - FcStrt + 1
          READ(71, REC=Ndx, ERR=872) Dy, Mn, Yr, (Z(J), J=1,5)
          DO J = 20, 24
            IF (Z(J-19) .GT. -999.) THEN
              DlyOtlk(J, Ndx) = Z(J - 19)
            END IF
          END DO
        END DO

        CLOSE (71)
        CALL FileWasClosed(71); IF (ErrorLevel .NE. 0) GOTO 899

!                                                           
!       ** ONLY IF USING OTLKWGTS.MXD FILE **
!
!      (25) End-of-Day Lake Level  (used for end-of-period values)
!      (26) End-of-Day Lake Level  (used to compute period means)
!           The second one is purely redundant, but it makes the code/calcs
!           easier to follow later on and is a minor RAM usage penalty.
!      (27) Inflow (cms)
!      (28) Outflow (cms)
!      (29) Total Basin Supply  (hundreds of cms)
!           We use hundredths of CMS because the valid range could be as
!           much as -9999 (or more negative).  Since our test for
!           missing data is any value < -999 the TBS ends up being
!           considered missing for many months.  We will use HUNDREDS
!           of cms to reduce range to within the non-missing range for
!           all calculations, then at the end (before printing) we will
!           multiply by 100 to put it back at cms for output.
!                                  
        IF (DoMixed) THEN
          IF ((Bsn .EQ. 'MIC') .OR. (Bsn .EQ. 'HUR') .OR. (Bsn .EQ. 'GEO')) THEN
             File75 = TRIM(ThisLakeDir) // 'LFTMHU'//CYear//'.INT'
          ELSE
             File75 = TRIM(ThisLakeDir) // 'LFT'//Bsn//CYear//'.INT'
          END IF
          OPEN(UNIT=75, FILE=TRIM(File75), STATUS='OLD', IOSTAT=IOS)
          IF (IOS .EQ. 0) THEN
             CALL FileWasOpened(75); IF (ErrorLevel .NE. 0) GOTO 899
             RNum = 1
             READ(75, *, ERR=877)
             READ(75, *, ERR=877)
             READ(75, 7501, ERR=877) Year, Mon, Day
             CALL DateSequence(Day, Mon, Year, Seq1);  IF (ErrorLevel .NE. 0) GOTO 899
             READ(75, 7501, ERR=877) Year, Mon, Day
             CALL DateSequence(Day, Mon, Year, Seq2);  IF (ErrorLevel .NE. 0) GOTO 899
             READ(75, *, ERR=877)

             IF ((Seq1 .NE. FcStrt) .OR. (Seq2 .NE. FcEnd)) THEN
               WRITE(ErrorMessage, 9905) TRIM(File75)
               CALL PassMsg
               GOTO 898
             ENDIF

             DO I = FcStrt, FcEnd
                Ndx = I - FcStrt + 1
                READ(75, 7502, ERR=877) Lev, IFlw, OFlw, TBS
                IF (Lev  .GT.   -999.) DlyOtlk(25, Ndx) = Lev
                IF (Lev  .GT.   -999.) DlyOtlk(26, Ndx) = Lev
                IF (IFlw .GT.   -999.) DlyOtlk(27, Ndx) = IFlw
                IF (OFlw .GT.   -999.) DlyOtlk(28, Ndx) = OFlw
                IF (TBS  .GT. -99999.) DlyOtlk(29, Ndx) = TBS / 100.
             ENDDO
             CLOSE (75)
             CALL FileWasClosed(75); IF (ErrorLevel .NE. 0) GOTO 899
             DoLevels = .TRUE.
          END IF

        END IF

!
!       Now that we have read in all of the daily data values, we are ready
!       to compute the values for the specified time-series.
!
        IF (TimeInt .EQ. 5) CALL ComputeAnn(FcStrt, OutStart, OutEnd, OtlkNum)
        IF (TimeInt .EQ. 4) CALL ComputeMon(FcStrt, OutStart, OutEnd, OtlkNum)
        IF (TimeInt .EQ. 3) CALL ComputeQmn(FcStrt, OutStart, OutEnd, OtlkNum)
        IF (TimeInt .EQ. 2) CALL ComputeWkl(FcStrt, OutStart, OutEnd, OtlkNum)
        IF (TimeInt .EQ. 1) CALL ComputeDly(FcStrt, OutStart, OutEnd, OtlkNum)
        IF (ErrorLevel .NE. 0) GOTO 899

        PercentDone = 95
        IF (.NOT. QuietMode) THEN
           WRITE(ErrorMessage, 9011) PercentDone
           CALL PassMsg
        END IF

        IF (DoDebug) THEN
            IF (TimeInt .EQ. 5) File11 = TRIM(ThisLakeDir) // 'O_ANN.INT'
            IF (TimeInt .EQ. 4) File11 = TRIM(ThisLakeDir) // 'O_MON.INT'
            IF (TimeInt .EQ. 3) File11 = TRIM(ThisLakeDir) // 'O_QMN.INT'
            IF (TimeInt .EQ. 2) File11 = TRIM(ThisLakeDir) // 'O_WKL.INT'
            IF (TimeInt .EQ. 1) File11 = TRIM(ThisLakeDir) // 'O_DLY.INT'
            IF (OtlkNum .EQ. 1) THEN
              ErrorMessage = 'Creating file ' // TRIM(File11); CALL PassMsg
              OPEN(UNIT=11, FILE=TRIM(File11), STATUS='REPLACE')
              CALL FileWasOpened(11); IF (ErrorLevel .NE. 0) GOTO 899
            ELSE
              OPEN(UNIT=11, FILE=TRIM(File11), STATUS='OLD', ACCESS='APPEND')
              CALL FileWasOpened(11); IF (ErrorLevel .NE. 0) GOTO 899
            END IF
            WRITE(11, 3911, ERR=813) FcStrt, OutStart, FcEnd
            WRITE(11, 3901, ERR=813) CYear, (I, I=1,31)
            DTtoPrint = DT
            IF (.NOT. DoMixed) DTtoPrint = DT - LevelDT
            DO J = 1, DTtoPrint
              WRITE(11, 3904, ERR=813) OutputHeaderLines(J)
              DbgVal(:,:) = -999.999
              DO Seq = OutStart, OutEnd
                IF (Seq .LT. FcStrt) THEN
                   I = Seq - DlyHistStart + 1
                   CALL SequenceDate(Day, Month, Year, Seq); IF (ErrorLevel .NE. 0) GOTO 899
                   DbgVal(Month,Day) = DlyHist(J,I)
                ELSE
                   I = Seq - FcStrt + 1
                   CALL SequenceDate(Day, Month, Year, Seq); IF (ErrorLevel .NE. 0) GOTO 899
                   DbgVal(Month,Day) = DlyOtlk(J,I)
                END IF
                IF (((Day .EQ. 31) .AND. (Month .EQ. 12)) .OR. (Seq .GE. OutEnd)) THEN
                  DO Month = 1, 12
                    DO Day = 1, 31
                      DbgOut(Month,Day) = '      --'
                      TVal = DbgVal(Month,Day)
                      IF ((TVal .GT. -999.998) .AND. (TVal .LT. 9999.999)) THEN
                         IF (J .LE. 26) THEN
                            WRITE(DbgOut(Month,Day), '(F8.3)') TVal
                         ELSE
                            WRITE(DbgOut(Month,Day), '(F8.0)') TVal
                            IF (J .EQ. 29) WRITE(DbgOut(Month,Day), '(F8.0)') TVal * 100.
                         END IF
                      END IF
                    END DO
                  END DO
                  DO Month = 1, 12
                    WRITE(11, 3905, ERR=813) Year, Month, (DbgOut(Month,Day), Day=1,31)
                  END DO
                  DbgVal(:,:) = -9999.99
                END IF
              END DO
            END DO
            CLOSE(11)
            CALL FileWasClosed(11); IF (ErrorLevel .NE. 0) GOTO 899

            IF (TimeInt .EQ. 4) THEN
               File11 = TRIM(ThisLakeDir) // 'NBS_MON.INT'
               IF (OtlkNum .EQ. 1) THEN
                 ErrorMessage = 'Creating file ' // TRIM(File11); CALL PassMsg
                 OPEN(UNIT=11, FILE=TRIM(File11), STATUS='REPLACE')
                 CALL FileWasOpened(11); IF (ErrorLevel .NE. 0) GOTO 899
               ELSE
                 OPEN(UNIT=11, FILE=TRIM(File11), STATUS='OLD', ACCESS='APPEND')
                 CALL FileWasOpened(11); IF (ErrorLevel .NE. 0) GOTO 899
               END IF
               WRITE(11, 3903, ERR=813) OtlkYr(OtlkNum)
               DO J=1,4
                 WRITE(11, 3904, ERR=813) OutputHeaderLines(J)
                 DbgVal(:,:) = -999.999
                 DO Seq = OutStart, OutEnd
                   IF (Seq .LT. FcStrt) THEN
                      I = Seq - DlyHistStart + 1
                      CALL SequenceDate(Day, Month, Year, Seq); IF (ErrorLevel .NE. 0) GOTO 899
                      DbgVal(Month,Day) = DlyHist(J,I)
                   ELSE
                      I = Seq - FcStrt + 1
                      CALL SequenceDate(Day, Month, Year, Seq); IF (ErrorLevel .NE. 0) GOTO 899
                      DbgVal(Month,Day) = DlyOtlk(J,I)
                   END IF
                   IF (((Day .EQ. 31) .AND. (Month .EQ. 12)) .OR. (Seq .GE. OutEnd)) THEN
                     M1 = 1
                     M2 = 12
                     IF (Year .EQ. FcYear) M1 = FcMon
                     IF (Seq .GE. OutEnd) THEN
                        CALL SequenceDate(Day, M2, Year, OutEnd); IF (ErrorLevel .NE. 0) GOTO 899
                     END IF
                     DO Month = M1, M2
                       DO Day = 1, 31
                         DbgOut(Month,Day) = '      --'
                         TVal = DbgVal(Month,Day)
                         IF ((TVal .GT. -999.998) .AND. (TVal .LT. 9999.999)) THEN
                            WRITE(DbgOut(Month,Day), '(F8.3)') TVal
                         END IF
                       END DO
                     END DO
                     DO Month = M1, M2
                       WRITE(11, 3905, ERR=813) Year, Month, (DbgOut(Month,Day), Day=1,31)
                     END DO
                     DbgVal(:,:) = -9999.99
                   END IF
                 END DO
               END DO
               CLOSE(11)
               CALL FileWasClosed(11); IF (ErrorLevel .NE. 0) GOTO 899
            END IF     ! (TimeInt .EQ. 4)

        END IF   ! {IF DoDebug}
      END DO   ! {DO OtlkNum=1, OutLks}


      IF (DoDebug) THEN
         IF (TimeInt .EQ. 4) THEN
            File11 = TRIM(ThisLakeDir) // 'NBS_MON.INT'
            OPEN(UNIT=11, FILE=TRIM(File11), STATUS='OLD', ACCESS='APPEND')
            CALL FileWasOpened(11); IF (ErrorLevel .NE. 0) GOTO 899
            WRITE(11, *, ERR=813)
            WRITE(11, *, ERR=813) 'Monthly values of NBS components for each outlook year'
            DO I = 1, OutLks
               WRITE(11, 3903, ERR=813) OtlkYr(OtlkNum)
               WRITE(11, 3931, ERR=813) 'RUN', (OtlkData(1,J,I), J=1,OutLen)
               WRITE(11, 3931, ERR=813) 'PRC', (OtlkData(2,J,I), J=1,OutLen)
               WRITE(11, 3931, ERR=813) 'EVP', (OtlkData(3,J,I), J=1,OutLen)
               WRITE(11, 3931, ERR=813) 'NBS', (OtlkData(4,J,I), J=1,OutLen)
               WRITE(11, *, ERR=813)
            END DO
            CLOSE(11)
            CALL FileWasClosed(11); IF (ErrorLevel .NE. 0) GOTO 899
         END IF
      END IF  


!
!     ***** Write the output file *****
!
      Ext = 'PRN'
      IF (DoMixed) Ext = 'MXD'
      IF (TimeInt .EQ. 5) File81 = TRIM(ThisLakeDir) // 'OTLKYEAR.' // Ext
      IF (TimeInt .EQ. 4) File81 = TRIM(ThisLakeDir) // 'OTLKMNTH.' // Ext
      IF (TimeInt .EQ. 3) File81 = TRIM(ThisLakeDir) // 'OTLKQMON.' // Ext
      IF (TimeInt .EQ. 2) File81 = TRIM(ThisLakeDir) // 'OTLKWKLY.' // Ext
      IF (TimeInt .EQ. 1) File81 = TRIM(ThisLakeDir) // 'OTLKDALY.' // Ext

      OPEN(UNIT=81, FILE=TRIM(File81), STATUS='OLD', ERR=81)
      CLOSE (81, STATUS='DELETE')
  81  OPEN(UNIT=81, FILE=TRIM(File81), STATUS='NEW', ERR=881)
      CALL FileWasOpened(81); IF (ErrorLevel .NE. 0) GOTO 899

!
!     Write the header info.
!
!     The LOGICAL variable "OK" is used to indicate if the forecast starts on
!     the beginning of the specified time interval.  If OK is FALSE, then we
!     will write a line in the output file informing the user that actual/modeled
!     data has been used to "backfill" the forecast.
!
      CALL SequenceDate(Day, Month, Year, FcStrt); IF (ErrorLevel .NE. 0) GOTO 899
      WRITE(81, 9101, ERR=883) TRIM(TimeStepString(TimeInt)), TRIM(FullLakeName(LakeNum))
      WRITE(81, 9102, ERR=883) MonthName3(Month), Day, Year

      OK = .TRUE.
      SELECT CASE (TimeInt)
         CASE (5)
             IF ((Day .NE. 1) .OR. (Month .NE. 1)) OK = .FALSE.
         CASE (4)
             IF (Day .NE. 1) OK = .FALSE.
         CASE (3)
             OK = IsFirstDayOfQtrMon(Day,Month,Year); IF (ErrorLevel .NE. 0) GOTO 899
      END SELECT
      IF (OK) THEN
         IF (TimeInt .EQ. 2) WRITE(81, *, ERR=883) 'Weeks begin on the date shown '
         IF (TimeInt .NE. 2) WRITE(81, *, ERR=883) ' '
      ELSE
         WRITE(81, 9103, ERR=883)
      ENDIF

      IF (TimeInt .EQ. 5) Column1 = 'YYYY'
      IF (TimeInt .EQ. 4) Column1 = 'YYYY/MM'
      IF (TimeInt .EQ. 3) Column1 = 'YYYY/MM-QQ'
      IF (TimeInt .EQ. 2) Column1 = 'YYYY/MM/DD'
      IF (TimeInt .EQ. 1) Column1 = 'YYYY/MM/DD'
      WRITE(81, 9104, ERR=883) TRIM(Column1), (INT(QntlPrcnt(J)*100 + 0.5), J=1,9)

      IF (TimeInt .EQ. 1) THEN
         TotHdr = 'Daily'
         AveHdr = 'Daily'
         EndHdr = 'Daily'
      ELSE
         TotHdr = 'Total'
         AveHdr = 'Average'
         IF (TimeInt .EQ. 2) EndHdr = 'End-of-Week'
         IF (TimeInt .EQ. 3) EndHdr = 'End-of-QtrMonth'
         IF (TimeInt .EQ. 4) EndHdr = 'End-of-Month'
         IF (TimeInt .EQ. 5) EndHdr = 'End-of-Year'
      END IF

!
!     How many data types are we going to output?
!
      DTtoPrint = DT
      IF (.NOT. DoMixed) DTtoPrint = DT - LevelDT

!                                                                
!     Write a second output file for use in later interpolations.
!     This file is in the format defined by TEC on 10aug2000.
!                                                                
      IF (TimeInt .EQ. 5) File85 = TRIM(ThisLakeDir) // 'OTLKYEAR.INT'
      IF (TimeInt .EQ. 4) File85 = TRIM(ThisLakeDir) // 'OTLKMNTH.INT'
      IF (TimeInt .EQ. 3) File85 = TRIM(ThisLakeDir) // 'OTLKQMON.INT'
      IF (TimeInt .EQ. 2) File85 = TRIM(ThisLakeDir) // 'OTLKWKLY.INT'
      IF (TimeInt .EQ. 1) File85 = TRIM(ThisLakeDir) // 'OTLKDALY.INT'
      OPEN(UNIT=85, FILE=TRIM(File85), STATUS='OLD', RECL=4,              &
     &     ACCESS='DIRECT', FORM='UNFORMATTED', ERR=85)
      CLOSE(85, STATUS='DELETE')
  85  OPEN(UNIT=85, FILE=TRIM(File85), STATUS='NEW', RECL=4,              &
     &     ACCESS='DIRECT', FORM='UNFORMATTED', ERR=886)
      CALL FileWasOpened(85); IF (ErrorLevel .NE. 0) GOTO 899
      WRITE(85, REC=1, ERR=888) DTtoPrint
      WRITE(85, REC=2, ERR=888) OutLen
      WRITE(85, REC=3, ERR=888) OutLks

!
!     Compute weighted results and save.
!
      DO K = 1, DTtoPrint
        IF (OutputType(K) .EQ. 1) S = TRIM(TotHdr)
        IF (OutputType(K) .EQ. 2) S = TRIM(AveHdr)
        IF (OutputType(K) .EQ. 3) S = TRIM(EndHdr)
        Line = TRIM(S) // ' ' // TRIM(HeaderLines(K))

        IF (DoCMS .AND. (K .LE. 4)) THEN
           S = TRIM(AveHdr)
           Line = TRIM(S) // ' ' // TRIM(CMSHdrLines(K))
        END IF

        WRITE(81, 9109, ERR=883) TRIM(Line)
        Seq1 = OutStart
        DO L = 1, OutLen
          
!
!         Pull out the data for this time period (for each of the outlooks)
!
          DO I = 1, Outlks            ! for each simulation (i.e. scenario year)
             A(I) = OtlkData(K, L, I)
             B(I) = I
          END DO

!
!         Sort sample A; B(I) will become the original array index of the Ith
!         value in the reordered array.
!
          CALL SortTwo(A, B, Outlks); IF (ErrorLevel .NE. 0) GOTO 899

!
!         Add to binary file OTLKxxxx.INT
!
          RNum = 3 + (K - 1) * OutLen * 2 * OutLks + (L - 1) * 2 * OutLks
          DO I = 1, OutLks
             WRITE(85, REC=RNum+I, ERR=888) A(I)
          ENDDO
          RNum = RNum + OutLks
          DO I = 1, OutLks
             WRITE(85, REC=RNum+I, ERR=888) OtlkWght(B(I))
          ENDDO

!
!         Compute sample cumulative frequency distribution.
!
          R4 = 0
          DO I = 1, Outlks
            R4 = R4 + OtlkWght(B(I))
            Y(I) = R4 / Outlks
          ENDDO

!
!         Interpolate c.d.f. for selected quantiles.
!         X() will contain the weighted results for output.
!
          I = 1
          DO J = 1, 9
            DO WHILE ((I .LE. Outlks) .AND. (Y(I) .LT. QntlPrcnt(J)))
              I = I + 1
            END DO
            I = I - 1
            IF (I .EQ. 0) THEN    ! Take A(0) = 2 * A(1) - A(2)
              X(J) = (A(2) - A(1)) / Y(1) * QntlPrcnt(J) + 2 * A(1) - A(2)
              I = 1
            ELSE
              X(J) = (A(I+1)-A(I))/(Y(I+1)-Y(I))*(QntlPrcnt(J)-Y(I)) + A(I)
            ENDIF
            IF ((.NOT. AllowNeg(K)) .AND. (X(J) .LT. 0)) X(J)=0
          END DO      !  {DO J = 1, 9}

!
!         Adjust total basin supply from hundreds of cms to cms
!
          IF (K .EQ. 29) THEN
             DO J = 1, 9
                X(J) = X(J) * 100.
             END DO
          END IF

!
!         Write the values to the output file
!
          CALL SequenceDate(Day, Month, Year, Seq1); IF (ErrorLevel .NE. 0) GOTO 899
          IF (TimeInt .EQ. 4) THEN
             CALL SequenceDate(D2, M2, Y2, Seq1+6);  IF (ErrorLevel .NE. 0) GOTO 899
          END IF
          Q = QtrMonNumber(Day, Month, Year)

          SELECT CASE (TimeInt)
             CASE (5)   
                     FormatStr = '(I4)'
             CASE (4)
                     FormatStr = '(I4, A1, I2)'
             CASE (1:3) 
                     FormatStr = '(I4, A1, I2, A1, I2)'
          END SELECT
          SELECT CASE (TimeInt)
             CASE (5)
                WRITE(81, FormatStr, ERR=883, ADVANCE='NO') Year
             CASE (4)
                WRITE(81, FormatStr, ERR=883, ADVANCE='NO') Year, Slash, Month
             CASE (3)
                WRITE(81, FormatStr, ERR=883, ADVANCE='NO') Year, Slash, Month, Dash, Q
             CASE (1:2)
                WRITE(81, FormatStr, ERR=883, ADVANCE='NO') Year, Slash, Month, Slash, Day
          END SELECT

          IF ((DoCMS .AND. (K .LE. 4)) .OR. (K .GE. 27)) THEN
             NumFormat = '(9F8.0)'
          ELSE
             NumFormat = '(9F8.2)'
          END IF              
          WRITE(81, NumFormat, ERR=883) (X(J), J=1,9)

          SELECT CASE (TimeInt)
             CASE (5)
                     CALL AdjustToEndOfYear(Seq1); IF (ErrorLevel .NE. 0) GOTO 899
                     Seq1 = Seq1 + 1
             CASE (4)
                     CALL AdjustToEndOfMonth(Seq1); IF (ErrorLevel .NE. 0) GOTO 899
                     Seq1 = Seq1 + 1
             CASE (3)
                     CALL AdjustToEndOfQtrMonth(Seq1); IF (ErrorLevel .NE. 0) GOTO 899
                     Seq1 = Seq1 + 1
             CASE (2)
                     Seq1 = Seq1 + 7
             CASE (1)
                     Seq1 = Seq1 + 1
          END SELECT
        END DO     !  {DO L = 1, OutLen}
      END DO     !  {DO K = 1, DT}

      WRITE(81, *, ERR=883) ' '

      CLOSE (51, STATUS='DELETE')
      CALL FileWasClosed(51); IF (ErrorLevel .NE. 0) GOTO 899
      CLOSE (81)
      CALL FileWasClosed(81); IF (ErrorLevel .NE. 0) GOTO 899
      CLOSE (85)
      CALL FileWasClosed(85); IF (ErrorLevel .NE. 0) GOTO 899

      PercentDone = 99
      IF (.NOT. QuietMode) THEN
         WRITE(ErrorMessage, 9011) PercentDone
         CALL PassMsg
      END IF

      GOTO 999

!
!  Handlers for I/O errors
!
  811 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File11)
      CALL PassMsg; GOTO 898
  812 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File11)
      CALL PassMsg; GOTO 898
  813 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File11)
      CALL PassMsg; GOTO 898
  821 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File21)
      CALL PassMsg; GOTO 898
  822 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File21)
      CALL PassMsg; GOTO 898
  823 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File21)
      CALL PassMsg; GOTO 898
  831 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File31)
      CALL PassMsg; GOTO 898
  832 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File31)
      CALL PassMsg; GOTO 898
  833 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File31)
      CALL PassMsg; GOTO 898
  841 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File41)
      CALL PassMsg; GOTO 898
  842 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File41)
      CALL PassMsg; GOTO 898
  843 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File41)
      CALL PassMsg; GOTO 898
  851 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File51)
      CALL PassMsg; GOTO 898
  852 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File51)
      CALL PassMsg; GOTO 898
  853 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File51)
      CALL PassMsg; GOTO 898
  861 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File61)
      CALL PassMsg; GOTO 898
  862 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File61)
      CALL PassMsg; GOTO 898
  863 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File61)
      CALL PassMsg; GOTO 898
  871 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File71)
      CALL PassMsg; GOTO 898
  872 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File71)
      CALL PassMsg; GOTO 898
  873 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File71)
      CALL PassMsg; GOTO 898
  876 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File75)
      CALL PassMsg; GOTO 898
  877 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File75)
      CALL PassMsg; GOTO 898
  878 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File75)
      CALL PassMsg; GOTO 898
  881 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File81)
      CALL PassMsg; GOTO 898
  882 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File81)
      CALL PassMsg; GOTO 898
  883 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File81)
      CALL PassMsg; GOTO 898
  886 ErrorMessage = 'POUTLOOK: Error opening file ' // TRIM(File85)
      CALL PassMsg; GOTO 898
  887 ErrorMessage = 'POUTLOOK: Error reading file ' // TRIM(File85)
      CALL PassMsg; GOTO 898
  888 ErrorMessage = 'POUTLOOK: Error writing file ' // TRIM(File85)
      CALL PassMsg; GOTO 898


  898 ErrorLevel = 1
  899 CALL MakeErrorInt
      ErrorMessage = '[traceback] : DO_POUTLOOK...'
      CALL PassMsg
      GOTO 999

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

  999 CALL CloseAllFiles

      IF (OtlkDataWasAllocated) THEN
         DEALLOCATE(OtlkData, STAT=IOS)
         IF (IOS .NE. 0) THEN
            ErrorMessage = 'POUTLOOK: Error deallocating RAM!'
            CALL PassMsg
            GOTO 898
         END IF
      END IF

      ErrStatus = ErrorLevel
      RETURN

!
!  FORMAT statements
!
 1101 FORMAT(A10)
 1102 FORMAT(2I3, I5)
 1103 FORMAT(I5)
 2101 FORMAT(I3, 3X, A4)
 2102 FORMAT(2I3, I5)
 3101 FORMAT(2I3, I5)
 3901 FORMAT(' Daily data used in POUTLOOK for scenario year ', A4, /,     &
     &       ' Year-Mn', 31(6X,I2))
 3903 FORMAT(/, 'Scenario Year = ', I4)
 3904 FORMAT(A)
 3905 FORMAT(I5, '-', I2, 31A8)
 3911 FORMAT('FcStrt, OutStart, FcEnd = ', 3I10)
 3931 FORMAT(A, 1X, 200F8.2)

 4101 FORMAT(E13.6E2)
 7501 FORMAT(5X, I5, 2I3)
 7502 FORMAT(F8.2, 3F9.0)

 8001 FORMAT('Day     Run     Prc     Evp     NBS  AT_Lnd    WTmp  AT_Lak    Vapr',  &
     &          '    Wind     Cld    IncR    RefR  NetLWR  LatntR   SensR    NetR',  &
     &          '    IceT    IceA    Heat    Soil    Grnd   Surfc    Snow   TotlM')
 8002 FORMAT(I3, 24F8.2)


 9011 FORMAT('~%~', I3.3)

 9101 FORMAT('Forecast quantiles of ', A, ' hydrology variables for ', A)
 9102 FORMAT('Outlooks start on ', A3, I3, ',', I5)
 9103 FORMAT('Actual or modeled data used for days prior to outlook start.')
 9104 FORMAT(A, 9(5X, I2, '%'))
 9109 FORMAT(A)

 9121 FORMAT(I4, 9F8.0)
 9122 FORMAT(I4, '/', I2, 9F8.0)
 9123 FORMAT(I4, '/', I2, '-', I2, 9F8.0)
 9124 FORMAT(I4, '/', I2, '/', I2, 9F8.0)
 9125 FORMAT(I4, '/', I2, '/', I2, 9F8.0)
 9131 FORMAT(I4, 9F8.2)
 9132 FORMAT(I4, '/', I2, 9F8.2)
 9133 FORMAT(I4, '/', I2, '-', I2, 9F8.2)
 9134 FORMAT(I4, '/', I2, '/', I2, 9F8.2)
 9135 FORMAT(I4, '/', I2, '/', I2, 9F8.2)

 9901 FORMAT('POUTLOOK: Forecast length exceeds program limits: redimension')
 9904 FORMAT('POUTLOOK: ', A, ' does not contain data for the required period!')
 9905 FORMAT('POUTLOOK: ', A, ' does not start on the forecast start date!')
 9906 FORMAT('POUTLOOK: Inconsistent dates; update data to same date!')
 9907 FORMAT('POUTLOOK: Forecast period in BSNNM does not match SIMULATE file!')
 9908 FORMAT('POUTLOOK: Error while reading outlook weights!')
 9909 FORMAT('POUTLOOK: Number of years in ', A, ' and ', A, ' do not agree! (',    &
     &                  I0, 'vs ', I0, ')')
 9927 FORMAT('POUTLOOK: Data period in ', A, ' incompatible for forecast!')
 9951 FORMAT(1X, A, I2, 1X, A3, 1X, I4)


      END SUBROUTINE DO_POUTLOOK

END MODULE POUTLOOK_Main


