maximum_net_infiltration.F90

Go to the documentation of this file.

!> @file
!! Contains the module \ref maximum_net_infiltration__gridded_data.
 
!>
!!  Module \ref maximum_net_infiltration__gridded_data
!!  provides support for adding miscellaneous source and sink terms.
 
module maximum_net_infiltration__gridded_data
 
  use iso_c_binding
  use constants_and_conversions
  use datetime
  use data_catalog
  use data_catalog_entry
  use dictionary
  use exceptions
  use file_operations
  use grid
  use logfiles
  use netcdf4_support
  use parameters, only          : params
  use simulation_datetime
  use fstring
  use fstring_list
 
  implicit none
 
  private
 
  public :: maximum_net_infiltration_initialize, maximum_net_infiltration_calculate
 
  type (data_catalog_entry_t), pointer :: pmaximum_net_infiltration
  real (c_float), allocatable     :: fmaximum_net_infiltration(:)
  real (c_float), allocatable     :: fmaximum_net_infiltration_array(:,:)
  real (c_float), allocatable     :: fmaximum_net_infiltration_table(:,:)
  type ( datetime_t ), pointer         :: date_of_last_retrieval
 
contains
 
  !> Initialize the routine to establish maximum potential recharge rates.
  !!
  !! Open gridded data file.
  !! Open a NetCDF output file to hold variable output.
  !!
  !! @param[in] lActive 2D array of active cells within the model domain.
  !! @param[in] iLanduseIndex 1D vector of indices corresponding to rows of the
  !!            landuse lookup table(s).
 
  subroutine maximum_net_infiltration_initialize( is_cell_active, landuse_index )
 
    logical (c_bool), intent(in)     :: is_cell_active(:,:)
    integer (c_int), intent(in)      :: landuse_index(:)
 
    ! [ LOCALS ]
    integer (c_int)                 :: istat
    type (fstring_list_t)                 :: parameter_list
    type (fstring_list_t)                 :: max_net_infiltration_list
    real (c_float), allocatable     :: max_net_infiltration_vector(:)
    integer (c_int), allocatable    :: sequence_nums(:)
    integer (c_int), allocatable    :: landuse_codes(:)
    logical (c_bool)                :: larelengthsequal
    integer (c_int)                 :: soils_indx
    integer (c_int)                 :: landuse_indx
    integer (c_int)                 :: number_of_landuses
    integer (c_int)                 :: number_of_soils
    real (c_float)                  :: value
    integer (c_int)                 :: month, day,year, julian_day
    character( len=:), allocatable       :: text_str
 
 
    type (data_catalog_entry_t), pointer :: phsg
    type (data_catalog_entry_t), pointer :: plulc
 
    plulc => dat%find("LAND_USE")
    phsg => dat%find("HYDROLOGIC_SOILS_GROUP")
 
    call assert( associated( plulc), "Possible INTERNAL PROGRAMMING ERROR -- Null pointer"          &
      //" detected for pLULC", __file__, __line__ )
 
    call assert( associated( plulc%pGrdBase ),   &
      "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pLULC%pGrdBase",            &
       __file__, __line__ )
 
    call assert( allocated( plulc%pGrdBase%iData ),   &
      "Possible INTERNAL PROGRAMMING ERROR -- Unallocated array detected for pLULC%pGrdBase%iData", &
      __file__, __line__ )
 
    call assert( associated( phsg), "Possible INTERNAL PROGRAMMING ERROR -- Null pointer"           &
      //" detected for pHSG", __file__, __line__ )
 
    call assert( associated( phsg%pGrdBase ),      &
      "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pHSG%pGrdBase",             &
       __file__, __line__ )
 
    call assert( allocated( phsg%pGrdBase%iData ),      &
      "Possible INTERNAL PROGRAMMING ERROR -- Unallocated array detected for pHSG%pGrdBase%iData",  &
       __file__, __line__ )
 
 
    ! attempt to find a source of GRIDDED MAXIMUM_NET_INFILTRATION data
    pmaximum_net_infiltration => dat%find( "MAXIMUM_NET_INFILTRATION" )
 
    ! retrieve a string list of all keys associated with Max_recharge (i.e. Max_recharge_1, Max_recharge_2, etc.)
    max_net_infiltration_list = params%grep_name("max_net_infil", lfatal=true )
 
    ! look for data in the form of a grid
    if ( associated( pmaximum_net_infiltration ) ) then
 
      allocate( fmaximum_net_infiltration( count( is_cell_active ) ), stat=istat )
      call assert( istat==0, "Problem allocating memory", __file__, __line__ )
 
      associate( dt => sim_dt%curr )
 
        if ( associated( pmaximum_net_infiltration ) ) then
          ! NB: maximum potential recharge
          call pmaximum_net_infiltration%getvalues( )
          if ( pmaximum_net_infiltration%lGridHasChanged )     &
            fmaximum_net_infiltration = pack( pmaximum_net_infiltration%pGrdBase%rData, is_cell_active )
        endif
 
      end associate
 
    elseif ( max_net_infiltration_list%get(1) /= "<NA>" ) then  ! no gridded data; read from TABLE values
 
      call parameter_list%append("LU_Code")
      call parameter_list%append("Landuse_Code")
      call parameter_list%append("Landuse_Lookup_Code")
 
      !> Determine how many landuse codes are present
      call params%get_parameters( slkeys=parameter_list, ivalues=landuse_codes )
      number_of_landuses = count( landuse_codes >= 0 )
 
      call params%get_parameters( fvalues=fmaximum_net_infiltration_table,     &
                                  sprefix="max_net_infil",                         &
                                  inumrows=number_of_landuses,                 &
                                  lfatal=true )
 
      number_of_soils = ubound( fmaximum_net_infiltration_table, 2 )
 
      call logs%WRITE( "| Landuse Code |  Soils Code  | Number of Matches | Maximum net infiltration (in) |",   &
        iloglevel = log_debug, lecho = false )
      call logs%WRITE( "|-------------|--------------|-------------------|--------------------------------| ",  &
        iloglevel = log_debug, lecho = false )
 
      allocate( fmaximum_net_infiltration_array( ubound(is_cell_active,1),ubound(is_cell_active,2) ), stat=istat )
      call assert( istat == 0, "Failed to allocate memory for maximum potential recharge table", &
        __file__, __line__)
 
      do soils_indx = 1, number_of_soils
        do landuse_indx = 1, number_of_landuses
 
          call logs%WRITE( "| "//ascharacter(landuse_codes( landuse_indx) )//" | "//ascharacter(soils_indx)//" | "//    &
              ascharacter(count( plulc%pGrdBase%iData == landuse_codes( landuse_indx)               &
                                   .and. phsg%pGrdBase%iData == soils_indx ) )//" | "          &
                                   //ascharacter( fmaximum_net_infiltration_table( landuse_indx, soils_indx))//" |", &
                                   iloglevel = log_debug, lecho = false )
 
           value = fmaximum_net_infiltration_table( landuse_indx, soils_indx )
 
           where ( plulc%pGrdBase%iData == landuse_codes( landuse_indx) .and. phsg%pGrdBase%iData == soils_indx )
 
             fmaximum_net_infiltration_array = value
 
           endwhere
 
        enddo
 
      enddo
 
      fmaximum_net_infiltration = pack( fmaximum_net_infiltration_array, is_cell_active )
 
      deallocate( fmaximum_net_infiltration_array )
      deallocate( fmaximum_net_infiltration_table )
 
      call parameter_list%clear()
 
    else  ! neither TABLE nor GRIDDED Maximum Potential Recharge values were given;
          ! default to ridiculously high maximum potential recharge
 
      allocate( fmaximum_net_infiltration( count( is_cell_active ) ), stat=istat )
      call assert( istat==0, "Problem allocating memory", __file__, __line__ )
 
      fmaximum_net_infiltration = 9999.0
 
      call warn( "Did not find any valid maximum net infiltration rate parameters.",    &
        lfatal = true )
 
    endif
 
  end subroutine maximum_net_infiltration_initialize
 
!--------------------------------------------------------------------------------------------------
 
  elemental subroutine maximum_net_infiltration_calculate( net_infiltration,    &
                                               rejected_net_infiltration,       &
                                               indx )
 
    real ( c_float), intent(inout)  :: net_infiltration
    real (c_float), intent(inout)   :: rejected_net_infiltration
    integer (c_int), intent(in)     :: indx
 
    if ( net_infiltration > fmaximum_net_infiltration( indx ) ) then
 
      rejected_net_infiltration = net_infiltration - fmaximum_net_infiltration( indx )
      net_infiltration = fmaximum_net_infiltration( indx )
 
    else
 
      rejected_net_infiltration = 0.0_c_float
 
    endif
 
  end subroutine maximum_net_infiltration_calculate
 
 
end module maximum_net_infiltration__gridded_data