et__zone_values.F90

Go to the documentation of this file.

!> @file
!! Contains the module \ref et__zone_values.
 
!>
!!  Module \ref et__zone_values
!!  provides support for estimating reference ET given a zone map
!!  of ET_ZONE.
module et__zone_values
 
  use iso_c_binding, only : c_short, c_int, c_float, c_double, c_bool
  use constants_and_conversions
  use data_catalog
  use data_catalog_entry
  use datetime
  use dictionary
  use exceptions
  use file_operations
  use simulation_datetime
  use fstring
  use fstring_list
 
  implicit none
 
  private
 
  public :: et_zone_values_initialize, et_zone_values_calculate
  public :: pet_grid, et_ratios
 
  real (c_float), allocatable           :: et_table_values(:,:)
 
  type (data_catalog_entry_t), pointer       :: pet_zone
  type (data_catalog_entry_t), pointer       :: pet_grid
 
  integer (c_int), allocatable          :: et_zone(:)
 
  real (c_float), allocatable           :: et_ratios(:)
 
 contains
 
  !> Initialize the ET grid.
  !!
  !! Read in a et zone grid.
  !!
  subroutine et_zone_values_initialize( lActive )
 
    logical (c_bool), intent(in)   :: lactive(:,:)
 
    ! [ LOCALS ]
    integer (c_int)      :: istat
    type (fstring_list_t)      :: slstring
 
    ! locate the data structure associated with ANNUAL gridded ET
    pet_grid => dat%find("POTENTIAL_ET")
    if ( .not. associated(pet_grid) ) then
      pet_grid => dat%find("REFERENCE_ET0")
      if (.not. associated(pet_grid) ) &
        call die("A POTENTIAL_ET or REFERENCE_ET0 grid must be supplied in order to make"   &
                 //" use of this option.", __file__, __line__)
    endif
 
! locate the data structure associated with the zone fog ratio entries
    pet_zone => dat%find("ET_ZONE")
    if ( .not. associated(pet_zone) ) &
        call die("A ET_ZONE grid must be supplied in order to make use of this option.", __file__, __line__)
 
    call pet_zone%getvalues( )
 
    allocate ( et_zone( count( lactive ) ), stat=istat )
    call assert(istat==0, "Failed to allocate memory for the ET_ZONE variable", __file__, __line__)
 
    et_zone = pack( pet_zone%pGrdBase%iData, lactive )
 
    allocate ( et_ratios( count( lactive ) ), stat=istat)
    call assert(istat==0, "Failed to allocate memory for the ET_RATIOS variable", __file__, __line__)
 
    ! look up the name of the fragments file in the control file dictionary
    call cf_dict%get_values( skey="ET_RATIO_MONTHLY_FILE", slstring=slstring )
 
    ! use the first entry in the string list slString as the filename to open for
    ! use with the daily fragments routine
    call read_et_ratio_table( slstring%get(1) )
 
  end subroutine et_zone_values_initialize
 
!--------------------------------------------------------------------------------------------------
 
  subroutine read_et_ratio_table( sFilename )
 
    character (len=*), intent(in)    :: sFilename
 
    ! [ LOCALS ]
    character (len=65536)   :: sRecord, sSubstring
    integer (c_int)    :: iStat
    integer (c_int)    :: iLineNum
    integer (c_int)    :: iFieldNum
    integer (c_int)    :: iIndex
    integer (c_int)    :: iNumLines
    integer (c_int)    :: iNumFields
    type (ASCII_FILE_T)     :: ET_RATIO_FILE
 
    integer (c_int), parameter :: ET_ZONE_FIELD = 1
 
    call et_ratio_file%open( sfilename = sfilename, &
                  scommentchars = "#%!", &
                  sdelimiters = "WHITESPACE", &
                  lhasheader = .false._c_bool )
 
    inumlines = et_ratio_file%numLines()
 
    ! read in next line of file
    srecord = et_ratio_file%readLine()
 
    inumfields = fieldcount( srecord )
 
    allocate(  et_table_values( inumlines, inumfields ), stat=istat )
    call assert( istat == 0, "Problem allocating memory for et ratio table values", &
      __file__, __line__ )
 
    ilinenum = 0
    ifieldnum = 0
 
    do
 
      ! read in next line of file
      srecord = et_ratio_file%readLine()
 
      if ( et_ratio_file%isEOF() ) exit
 
      ilinenum = ilinenum + 1
      ifieldnum = 0
 
      ! read in ET_ZONE
      call chomp(srecord, ssubstring, et_ratio_file%sDelimiters )
 
      if ( len_trim(ssubstring) == 0 ) &
      call die( "Missing ET ZONE in the monthly et ratio file",              &
               __file__, __line__, "Problem occured on line number "       &
               //ascharacter(et_ratio_file%currentLineNum() )             &
               //" of file "//dquote(sfilename) )
 
       et_table_values(et_zone_field, ilinenum ) = asint( ssubstring )
 
       do iindex = 2, inumfields
 
!         ! read in ET for each month of yeat
         call chomp(srecord, ssubstring, et_ratio_file%sDelimiters )
 
         if ( len_trim(ssubstring) == 0 ) &
           call die( "Missing or corrupt value in the et ratio file",        &
                     __file__, __line__, "Problem occured on line number "    &
                     //ascharacter(et_ratio_file%currentLineNum() )          &
                     //" of file "//dquote(sfilename) )
 
         et_table_values(ilinenum, iindex ) = asfloat( ssubstring )
 
      enddo
 
    enddo
 
  end subroutine read_et_ratio_table
 
!--------------------------------------------------------------------------------------------------
 
  subroutine et_zone_values_calculate( )
 
    ! [ LOCALS ]
    integer (c_int)  :: ilinenum
    integer (c_int)  :: ifieldnum
    integer (c_int)  :: iet_zone_id
    real (c_float)   :: ffactor
    integer (c_int)  :: icount
 
    et_ratios = 0.0_c_float
    icount = 0.0_c_float
 
    associate( dt => sim_dt%curr )
 
      call pet_grid%getvalues( dt )
 
      ! this assumes the input file is structured such that fields 2-13
      ! correspond to the ET ratios for months 1-12 (Jan-Dec)
      ifieldnum = dt%iMonth + 1
 
      ! if it is the first day of the month, update the ratio values
      if ( dt%iDay == 1 ) then
 
        do ilinenum = lbound(et_table_values, 1), ubound(et_table_values, 1)
 
          iet_zone_id = et_table_values(ilinenum, 1)
          icount = icount + count( et_zone == ifieldnum )
 
          where ( et_zone == iet_zone_id )
 
            et_ratios = et_table_values( ilinenum, ifieldnum )
 
          end where
 
        enddo
 
      endif
 
    end associate
 
  end subroutine et_zone_values_calculate
 
end module et__zone_values