runoff__gridded_values.F90

Go to the documentation of this file.

!> @file
!! Contains the module \ref runoff__gridded_values.
 
!>
!!  Module \ref runoff__gridded_values
!!  provides support for estimating fog drip given a gridded map
!!  of RUNOFF_ZONE, and a table containing monthly
!!  fog factors.
module runoff__gridded_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 :: runoff_gridded_values_initialize, runoff_gridded_values_update_ratios
 
  real (c_float), allocatable           :: runoff_table_values(:,:)
  type ( datetime_t ), allocatable           :: runoff_table_dates(:)
 
  type (data_catalog_entry_t), pointer       :: prunoff_zone
  integer (c_int), allocatable          :: runoff_zone(:)
 
  real (c_float), allocatable, public   :: runoff_ratios(:)
 
 contains
 
  !> Initialize the infiltration grid.
  !!
  !! Read in a runoff zone grid.
  !!
  subroutine runoff_gridded_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 the gridded fog ratio entries
    prunoff_zone => dat%find("RUNOFF_ZONE")
    if ( .not. associated(prunoff_zone) ) &
        call die("A RUNOFF_ZONE grid must be supplied in order to make use of this option.", __file__, __line__)
 
    call prunoff_zone%getvalues( )
 
    allocate ( runoff_zone( count( lactive ) ), stat=istat )
    call assert(istat==0, "Failed to allocate memory for the RUNOFF_ZONE variable", __file__, __line__)
 
    runoff_zone = pack( prunoff_zone%pGrdBase%iData, lactive )
 
    allocate ( runoff_ratios( count( lactive ) ), stat=istat)
    call assert(istat==0, "Failed to allocate memory for the RUNOFF_RATIOS variable", __file__, __line__)
 
 
    ! look up the name of the fragments file in the control file dictionary
    call cf_dict%get_values( skey="RUNOFF_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_runoff_ratio_table( slstring%get(1) )
 
  end subroutine runoff_gridded_values_initialize
 
!--------------------------------------------------------------------------------------------------
 
  subroutine read_runoff_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), allocatable :: RUNOFF_RATIO_FILE
 
    allocate(runoff_ratio_file)
 
    call runoff_ratio_file%open( sfilename = sfilename, &
                  scommentchars = "#%!", &
                  sdelimiters = "WHITESPACE", &
                  lhasheader = .true._c_bool )
 
    inumlines = runoff_ratio_file%numLines()
 
    ! read in next line of file
    srecord = runoff_ratio_file%readLine()
 
    inumfields = fieldcount( srecord )
 
    allocate(  runoff_table_values( inumlines, inumfields -1 ), stat=istat )
    call assert( istat == 0, "Problem allocating memory for runoff ratio table values", &
      __file__, __line__ )
 
    allocate(  runoff_table_dates( inumlines ), stat=istat )
    call assert( istat == 0, "Problem allocating memory for runoff ratio table date values vector", &
      __file__, __line__ )
 
 
    ilinenum = 0
    ifieldnum = 0
 
    do
 
      ! read in next line of file
      srecord = runoff_ratio_file%readLine()
 
      if ( runoff_ratio_file%isEOF() ) exit
 
      ilinenum = ilinenum + 1
      ifieldnum = 0
 
      ! read in date
      call chomp(srecord, ssubstring, runoff_ratio_file%sDelimiters )
 
      if ( len_trim(ssubstring) == 0 ) &
      call die( "Missing date in the monthly runoff ratio file",              &
               __file__, __line__, "Problem occured on line number "       &
               //ascharacter(runoff_ratio_file%currentLineNum() )             &
               //" of file "//dquote(sfilename) )
 
      call runoff_table_dates( ilinenum )%parseDate( ssubstring )
 
       do iindex = 2, inumfields
 
!         ! read in fragment for given day of month
         call chomp(srecord, ssubstring, runoff_ratio_file%sDelimiters )
 
         if ( len_trim(ssubstring) == 0 ) &
           call die( "Missing or corrupt value in the runoff ratio file",        &
                     __file__, __line__, "Problem occured on line number "    &
                     //ascharacter(runoff_ratio_file%currentLineNum() )          &
                     //" of file "//dquote(sfilename) )
 
         runoff_table_values(ilinenum, iindex - 1 ) = asfloat( ssubstring )
 
      enddo
 
    enddo
 
 
  end subroutine read_runoff_ratio_table
 
!--------------------------------------------------------------------------------------------------
 
  subroutine runoff_gridded_values_update_ratios( )
 
    ! [ LOCALS ]
    integer (c_int)  :: ilinenum
    integer (c_int)  :: ifieldnum
    logical (c_bool) :: lmatch
    integer (c_int)  :: icount
 
    lmatch = false
    icount = 0
 
    do ilinenum = lbound( runoff_table_dates, 1), ubound( runoff_table_dates, 1) - 1
 
      ! locate the relevant line in the runoff table in the basis of the date range
      if (     ( runoff_table_dates( ilinenum ) <= sim_dt%curr )   &
        .and.  ( runoff_table_dates( ilinenum + 1 ) > sim_dt%curr ) )  then
 
          lmatch = true
          exit
      endif
 
    enddo
 
    if ( .not. lmatch )   &
      call die( "Failed to find an appropriate date value in the RUNOFF_RATIO file.", &
        __file__, __line__ )
 
    ! now that we have the relevant line of data, distribute values, assuming that
    ! the runoff zone ids is sequential and corresponds to the field numbers
 
    runoff_ratios = 0.0_c_float
 
    do ifieldnum = lbound(runoff_table_values, 2), ubound(runoff_table_values, 2)
 
      icount = icount + count( runoff_zone == ifieldnum )
 
      where ( runoff_zone == ifieldnum )
 
        runoff_ratios = runoff_table_values( ilinenum, ifieldnum )
 
      end where
 
    enddo
 
  end subroutine runoff_gridded_values_update_ratios
 
end module runoff__gridded_values