! cetgeneral.f90
! module in which various CET routines with general applicability are held
! contains: FillSeaAnnMean, FillSeaAnnMin, FillSeaAnnMax, FillSeaAnnSum, 
!       FillDailyMean, FillDailyMin, FillDailyMax, FillDailySum

module CETGeneral

use Time

implicit none

contains

!*******************************************************************************
! fill monthly array with means from the daily array

subroutine FillDailyMean (MissAccept,YearAD,Daily,Monthly)

real, dimension (:,:,:), pointer 	:: Daily
real, dimension (:,:), pointer 		:: Monthly

integer, dimension (:,:), pointer 	:: MonthLengths
integer, dimension (:), pointer 	:: YearAD

real, intent(in) :: MissAccept

real, parameter :: MissVal = -999.0

real :: OpTot, OpEn, OpMiss, OpCheck, MissThresh

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XDay

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Daily,1)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.12.NE.size(Daily,2).OR.31.NE.size(Daily,3)) then
	Abandon = 1
end if

allocate (MonthLengths(YearN,12), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailySum #####"

call GetMonthLengths (YearAD,MonthLengths)

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XMonth = 1, 12
      OpTot  = 0.0
      OpEn   = 0.0
      
      do XDay = 1, MonthLengths(XYear,XMonth)
        if (Daily(XYear,XMonth,XDay).NE.MissVal) then
          OpTot = OpTot + Daily(XYear,XMonth,XDay)
          OpEn  = OpEn  + 1
        end if
      end do
      
      OpMiss   = MonthLengths(XYear,XMonth) - OpEn
      MissThresh = (MissAccept/100)*MonthLengths(XYear,XMonth)
      
      if (OpMiss.LE.MissThresh) then
        Monthly(XYear,XMonth) = OpTot / OpEn
        OpCheck               = OpTot / 28			! ##############
      else
        Monthly(XYear,XMonth) = MissVal
      end if
      								! ##############
      if (XMonth.EQ.2) write (99,"(i6,2f12.4)"), YearAD(XYear), Monthly(XYear,XMonth), OpCheck
    end do
  end do
else
  print*, "  > FillDailyMean: array size mismatch."
end if

deallocate (MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailyMean: Deallocation failure #####"

end subroutine FillDailyMean

!*******************************************************************************
! fill each month with min value from the daily array for that month

subroutine FillDailyMin (MissAccept,YearAD,Daily,Monthly)

real, dimension (:,:,:), pointer 	:: Daily
real, dimension (:,:), pointer 		:: Monthly

integer, dimension (:,:), pointer 	:: MonthLengths
integer, dimension (:), pointer 	:: YearAD

real, intent(in) :: MissAccept

real, parameter :: MissVal = -999.0

real :: OpMin, OpEn, OpMiss, MissThresh

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XDay

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Daily,1)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.12.NE.size(Daily,2).OR.31.NE.size(Daily,3)) then
	Abandon = 1
end if

allocate (MonthLengths(YearN,12), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailySum #####"

call GetMonthLengths (YearAD,MonthLengths)

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XMonth = 1, 12
      OpMin  = 1000000.0
      OpEn   = 0.0
      
      do XDay = 1, MonthLengths(XYear,XMonth)
        if (Daily(XYear,XMonth,XDay).NE.MissVal) then
          if (Daily(XYear,XMonth,XDay).LT.OpMin) OpMin = Daily(XYear,XMonth,XDay)
          OpEn  = OpEn  + 1
        end if
      end do
      
      OpMiss   = MonthLengths(XYear,XMonth) - OpEn
      MissThresh = (MissAccept/100)*MonthLengths(XYear,XMonth)
      
      if (OpMiss.LE.MissThresh) then
        Monthly(XYear,XMonth) = OpMin
      else
        Monthly(XYear,XMonth) = MissVal
      end if
    end do
  end do
else
  print*, "  > FillDailyMin: array size mismatch."
end if

deallocate (MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailyMin: Deallocation failure #####"

end subroutine FillDailyMin

!*******************************************************************************
! fill each month with Max value from the daily array for that month

subroutine FillDailyMax (MissAccept,YearAD,Daily,Monthly)

real, dimension (:,:,:), pointer 	:: Daily
real, dimension (:,:), pointer 		:: Monthly

integer, dimension (:,:), pointer 	:: MonthLengths
integer, dimension (:), pointer 	:: YearAD

real, intent(in) :: MissAccept

real, parameter :: MissVal = -999.0

real :: OpMax, OpEn, OpMiss, MissThresh

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XDay

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Daily,1)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.12.NE.size(Daily,2).OR.31.NE.size(Daily,3)) then
	Abandon = 1
end if

allocate (MonthLengths(YearN,12), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailySum #####"

call GetMonthLengths (YearAD,MonthLengths)

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XMonth = 1, 12
      OpMax  = -1000000.0
      OpEn   = 0.0
      
      do XDay = 1, MonthLengths(XYear,XMonth)
        if (Daily(XYear,XMonth,XDay).NE.MissVal) then
          if (Daily(XYear,XMonth,XDay).GT.OpMax) OpMax = Daily(XYear,XMonth,XDay)
          OpEn  = OpEn  + 1
        end if
      end do
      
      OpMiss   = MonthLengths(XYear,XMonth) - OpEn
      MissThresh = (MissAccept/100)*MonthLengths(XYear,XMonth)
      
      if (OpMiss.LE.MissThresh) then
        Monthly(XYear,XMonth) = OpMax
      else
        Monthly(XYear,XMonth) = MissVal
      end if
    end do
  end do
else
  print*, "  > FillDailyMax: array size mismatch."
end if

deallocate (MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailyMax: Deallocation failure #####"

end subroutine FillDailyMax

!*******************************************************************************
! fill monthly array with sums from the daily array

subroutine FillDailySum (MissAccept,YearAD,Daily,Monthly)

real, dimension (:,:,:), pointer 	:: Daily
real, dimension (:,:), pointer 		:: Monthly

integer, dimension (:,:), pointer 	:: MonthLengths
integer, dimension (:), pointer 	:: YearAD

real, intent(in) :: MissAccept

real, parameter :: MissVal = -999.0

real :: OpTot, OpEn, OpMiss, OpCheck, MissThresh

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XDay

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Daily,1)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.12.NE.size(Daily,2).OR.31.NE.size(Daily,3)) then
	Abandon = 1
end if

allocate (MonthLengths(YearN,12), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailySum #####"

call GetMonthLengths (YearAD,MonthLengths)

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XMonth = 1, 12
      OpTot  = 0.0
      OpEn   = 0.0
      
      do XDay = 1, MonthLengths(XYear,XMonth)
        if (Daily(XYear,XMonth,XDay).NE.MissVal) then
          OpTot = OpTot + Daily(XYear,XMonth,XDay)
          OpEn  = OpEn  + 1
        end if
      end do
      
      OpMiss     = MonthLengths(XYear,XMonth) - OpEn
      MissThresh = (MissAccept/100)*MonthLengths(XYear,XMonth)
      
      if      (OpMiss.EQ.0) then
        Monthly(XYear,XMonth) =  OpTot
      else if (OpMiss.LE.MissThresh) then
        Monthly(XYear,XMonth) = (OpTot / OpEn) * MonthLengths(XYear,XMonth)
      else
        Monthly(XYear,XMonth) = MissVal
      end if
    end do
  end do
else
  print*, "  > FillDailySum: array size mismatch."
end if

deallocate (MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillDailySum: Deallocation failure #####"

end subroutine FillDailySum

!*******************************************************************************
! fill seasonal and annual arrays with means from the monthly array

subroutine FillSeaAnnMean (YearAD,Monthly,Seasonal,Annual)

real, dimension (:,:), pointer 		:: Monthly, Seasonal
real, dimension (:), pointer 		:: Annual

integer, dimension (:,:), pointer 	:: MonthLengths
integer, dimension (:), pointer 	:: YearAD

real, parameter :: MissVal = -999.0

real :: OpTot, OpEn, OpMiss

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XSeason

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Seasonal,1).OR.YearN.NE.size(Annual)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.4.NE.size(Seasonal,2)) then
	Abandon = 1
end if

allocate (MonthLengths(YearN,12), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillSeaAnnMean: allocation failure #####"

call GetMonthLengths (YearAD,MonthLengths)

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XSeason = 1, 4
      OpMiss = 0
      OpTot  = 0
      OpEn   = 0
      
      do XMonth = (XSeason*3), ((XSeason*3)+2)
        if (XMonth.LE.12) then
            if (Monthly(XYear,XMonth).NE.MissVal) then
              OpTot  = OpTot  + (Monthly(XYear,XMonth)*MonthLengths(XYear,XMonth))
              OpEn   = OpEn   +  MonthLengths(XYear,XMonth)
            else
              OpMiss = OpMiss +  MonthLengths(XYear,XMonth)
            end if
        else
          if (XYear.LT.YearN) then
            if (Monthly((XYear+1),(XMonth-12)).NE.MissVal) then
              OpTot  = OpTot  + (Monthly((XYear+1),(XMonth-12))*MonthLengths((XYear+1),(XMonth-12)))
              OpEn   = OpEn   +  MonthLengths((XYear+1),(XMonth-12))
            else
              OpMiss = OpMiss +  MonthLengths((XYear+1),(XMonth-12))
            end if
          else
              OpMiss = OpMiss + 30
          end if
        end if
      end do
      
      if (OpMiss.EQ.0) then
        Seasonal(XYear,XSeason) = OpTot / OpEn
      else
        Seasonal(XYear,XSeason) = MissVal
      end if
    end do
    
    OpMiss = 0
    OpTot  = 0
    OpEn   = 0
      
    do XMonth = 1, 12
      if (Monthly(XYear,XMonth).NE.MissVal) then
              OpTot  = OpTot  + (Monthly(XYear,XMonth)*MonthLengths(XYear,XMonth))
              OpEn   = OpEn   +  MonthLengths(XYear,XMonth)
      else
              OpMiss = OpMiss +  MonthLengths(XYear,XMonth)
      end if      
    end do

    if (OpMiss.EQ.0) then
        Annual(XYear) = OpTot / OpEn
    else
        Annual(XYear) = MissVal
    end if
  end do
else
  print*, "  > FillSeaAnnMean: array size mismatch."
end if

deallocate (MonthLengths, stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: FillSeaAnnMean: Deallocation failure #####"

end subroutine FillSeaAnnMean

!*******************************************************************************
! fill seasonal and annual arrays with minimum values from the monthly array

subroutine FillSeaAnnMin (YearAD,Monthly,Seasonal,Annual)

real, dimension (:,:), pointer 		:: Monthly, Seasonal
real, dimension (:), pointer 		:: Annual

integer, dimension (:), pointer 	:: YearAD

real, parameter :: MissVal = -999.0

real :: OpMin, OpMiss

integer :: ReadStatus, Abandon
integer :: YearN
integer :: XYear, XMonth, XSeason

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Seasonal,1).OR.YearN.NE.size(Annual)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.4.NE.size(Seasonal,2)) then
	Abandon = 1
end if

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XSeason = 1, 4
      OpMin  = 100000.0
      OpMiss = 0
      
      do XMonth = (XSeason*3), ((XSeason*3)+2)
        if (XMonth.LE.12) then
            if (Monthly(XYear,XMonth).NE.MissVal) then
              if (Monthly(XYear,XMonth).LT.OpMin) OpMin = Monthly(XYear,XMonth)
            else
              OpMiss = OpMiss + 1
            end if
        else
          if (XYear.LT.YearN) then
            if (Monthly((XYear+1),(XMonth-12)).NE.MissVal) then
              if (Monthly((XYear+1),(XMonth-12)).LT.OpMin) OpMin = Monthly((XYear+1),(XMonth-12))
            else
              OpMiss = OpMiss + 1
            end if
          else
              OpMiss = OpMiss + 1
          end if
        end if
      end do
      
      if (OpMiss.EQ.0) then
        Seasonal(XYear,XSeason) = OpMin
      else
        Seasonal(XYear,XSeason) = MissVal
      end if
    end do
    
    OpMin  = 100000.0
    OpMiss = 0

    do XMonth = 1, 12
      OpMin  = 100000.0
      OpMiss = 0
      
      if (Monthly(XYear,XMonth).NE.MissVal) then
              if (Monthly(XYear,XMonth).LT.OpMin) OpMin = Monthly(XYear,XMonth)
      else
              OpMiss = OpMiss + 1
      end if
    end do

    if (OpMiss.EQ.0) then
        Annual(XYear) = OpMin
    else
        Annual(XYear) = MissVal
    end if
  end do
else
  print*, "  > FillSeaAnnMin: array size mismatch."
end if

end subroutine FillSeaAnnMin

!*******************************************************************************
! fill seasonal and annual arrays with Maximum values from the monthly array

subroutine FillSeaAnnMax (YearAD,Monthly,Seasonal,Annual)

real, dimension (:,:), pointer 		:: Monthly, Seasonal
real, dimension (:), pointer 		:: Annual

integer, dimension (:), pointer 	:: YearAD

real, parameter :: MissVal = -999.0

real :: OpMax, OpMiss

integer :: ReadStatus, Abandon
integer :: YearN
integer :: XYear, XMonth, XSeason

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Seasonal,1).OR.YearN.NE.size(Annual)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.4.NE.size(Seasonal,2)) then
	Abandon = 1
end if

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XSeason = 1, 4
      OpMax  = -100000.0
      OpMiss = 0
      
      do XMonth = (XSeason*3), ((XSeason*3)+2)
        if (XMonth.LE.12) then
            if (Monthly(XYear,XMonth).NE.MissVal) then
              if (Monthly(XYear,XMonth).GT.OpMax) OpMax = Monthly(XYear,XMonth)
            else
              OpMiss = OpMiss + 1
            end if
        else
          if (XYear.LT.YearN) then
            if (Monthly((XYear+1),(XMonth-12)).NE.MissVal) then
              if (Monthly((XYear+1),(XMonth-12)).GT.OpMax) OpMax = Monthly((XYear+1),(XMonth-12))
            else
              OpMiss = OpMiss + 1
            end if
          else
              OpMiss = OpMiss + 1
          end if
        end if
      end do
      
      if (OpMiss.EQ.0) then
        Seasonal(XYear,XSeason) = OpMax
      else
        Seasonal(XYear,XSeason) = MissVal
      end if
    end do
    
    OpMax  = -100000.0
    OpMiss = 0
      
    do XMonth = 1, 12
      if (Monthly(XYear,XMonth).NE.MissVal) then
              if (Monthly(XYear,XMonth).GT.OpMax) OpMax = Monthly(XYear,XMonth)
      else
              OpMiss = OpMiss + 1
      end if
    end do

    if (OpMiss.EQ.0) then
        Annual(XYear) = OpMax
    else
        Annual(XYear) = MissVal
    end if
  end do
else
  print*, "  > FillSeaAnnMax: array size mismatch."
end if

end subroutine FillSeaAnnMax

!*******************************************************************************
! fill seasonal and annual arrays with sums from the monthly array

subroutine FillSeaAnnSum (YearAD,Monthly,Seasonal,Annual)

real, dimension (:,:), optional 	:: Monthly, Seasonal
real, dimension (:), optional 		:: Annual

integer, dimension (:), pointer 	:: YearAD

real, parameter :: MissVal = -999.0

real :: OpTot, OpEn, OpMiss

integer :: ReadStatus, Abandon, AllocStat
integer :: YearN
integer :: XYear, XMonth, XSeason

!***************************************

Abandon = 0

YearN = size (YearAD)					! get and check sizes
if      (YearN.NE.size(Monthly,1).OR.YearN.NE.size(Seasonal,1).OR.YearN.NE.size(Annual)) then
	Abandon = 1
else if (12.NE.size(Monthly,2).OR.4.NE.size(Seasonal,2)) then
	Abandon = 1
end if

if (Abandon.EQ.0) then
  do XYear = 1, YearN
    do XSeason = 1, 4
      OpMiss = 0
      OpTot  = 0
      
      do XMonth = (XSeason*3), ((XSeason*3)+2)
        if (XMonth.LE.12) then
            if (Monthly(XYear,XMonth).NE.MissVal) then
              OpTot  = OpTot  +  Monthly(XYear,XMonth)
            else
              OpMiss = OpMiss +  1
            end if
        else
          if (XYear.LT.YearN) then
            if (Monthly((XYear+1),(XMonth-12)).NE.MissVal) then
              OpTot  = OpTot  +  Monthly((XYear+1),(XMonth-12))
            else
              OpMiss = OpMiss +  1
            end if
          else
              OpMiss = OpMiss +  1
          end if
        end if
      end do
      
      if (OpMiss.EQ.0) then
        Seasonal(XYear,XSeason) = OpTot
      else
        Seasonal(XYear,XSeason) = MissVal
      end if
    end do
    
    OpMiss = 0
    OpTot  = 0
      
    do XMonth = 1, 12
      if (Monthly(XYear,XMonth).NE.MissVal) then
              OpTot  = OpTot  +  Monthly(XYear,XMonth)
      else
              OpMiss = OpMiss +  1
      end if      
    end do

    if (OpMiss.EQ.0) then
        Annual(XYear) = OpTot
    else
        Annual(XYear) = MissVal
    end if
  end do
else
  print*, "  > FillSeaAnnSum: array size mismatch."
end if

end subroutine FillSeaAnnSum

!*******************************************************************************

end module CETGeneral