direct_net_infiltration__gridded_data.F90

Go to the documentation of this file.

!> @file
!! Contains the module \ref direct_net_infiltration__gridded_data.
 
!>
!!  Module \ref direct_net_infiltration__gridded_data
!!  provides support for adding miscellaneous source and sink terms.
 
module direct_net_infiltration__gridded_data
 
  use iso_c_binding
  use constants_and_conversions
  use data_catalog
  use data_catalog_entry
  use datetime
  use dictionary
  use exceptions
  use file_operations
  use netcdf4_support
  use parameters, only          : params
  use simulation_datetime
  use fstring
  use fstring_list
 
  implicit none
 
  private
 
  public :: direct_net_infiltration_initialize, direct_net_infiltration_calculate
 
  type (data_catalog_entry_t), pointer :: pcesspool
  type (data_catalog_entry_t), pointer :: pdisposal_well
  type (data_catalog_entry_t), pointer :: pwater_body_recharge
  type (data_catalog_entry_t), pointer :: pwater_main
  type (data_catalog_entry_t), pointer :: pannual_recharge_rate
 
  real (c_float), allocatable     :: fcesspool(:)
  real (c_float), allocatable     :: fdisposal_well(:)
  real (c_float), allocatable     :: fwater_body_recharge(:)
  real (c_float), allocatable     :: fwater_main(:)
  real (c_float), allocatable     :: fannual_recharge_rate(:)
 
  ! ****_TABLE variables: will have same number of values as there are landuses
  real (c_float), allocatable     :: fcesspool_table(:)
  real (c_float), allocatable     :: fdisposal_well_table(:)
  real (c_float), allocatable     :: fwater_body_recharge_table(:)
  real (c_float), allocatable     :: fwater_main_table(:)
  real (c_float), allocatable     :: fannual_recharge_rate_table(:)
 
  type (t_netcdf4_file), pointer       :: pncfile
 
  type ( datetime_t )                  :: date_of_last_retrieval
 
contains
 
  !> Initialize the routine to enable input/output of arbitrary sources/sink terms.
  !!
  !! Open gridded data file.
  !! Open a NetCDF output file to hold variable output.
  !!
  !! @param[in] is_cell_active 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).
  !! @param[in] dX 1D vector of X coordinates associated with the model domain.
  !! @param[in] dY 1D vector of Y coordinates.
  !! @param[in] dX_lon 2D array of longitude values.
  !! @param[in] dY_lat 2D array of latitude values.
 
  subroutine direct_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)                 :: status
    type (fstring_list_t)                 :: parameter_list
    integer (c_int)                 :: indx
    integer (c_int)                 :: inx
    integer (c_int)                 :: iny
    integer (c_int), allocatable    :: landuse_codes(:)
    integer (c_int)                 :: number_of_landuses
    logical (c_bool)                :: are_lengths_equal
 
 
    !> Determine how many landuse codes are present
    call parameter_list%append( "LU_Code" )
    call parameter_list%append( "Landuse_Code" )
    call parameter_list%append( "Landuse_Lookup_Code" )
 
    call params%get_parameters( slkeys=parameter_list, ivalues=landuse_codes )
    number_of_landuses = count( landuse_codes > 0 )
 
    call parameter_list%clear()
    call parameter_list%append( "Annual_direct_net_infiltration_rate" )
    call parameter_list%append( "Annual_direct_recharge_rate" )
    call parameter_list%append( "Annual_direct_recharge" )
    call parameter_list%append( "Annual_direct_net_infiltration" )
 
    call params%get_parameters( slkeys=parameter_list , fvalues=fannual_recharge_rate_table )
 
    ! attempt to find a source of GRIDDED ANNUAL DIRECT RECHARGE data
    pannual_recharge_rate => dat%find( "ANNUAL_DIRECT_NET_INFILTRATION_RATE" )
 
 
    call parameter_list%clear()
    call parameter_list%append( "Cesspool_direct_net_infiltration" )
    call parameter_list%append( "Cesspool_recharge" )
    call parameter_list%append( "Cesspool_discharge" )
    call parameter_list%append( "Cesspool_leakage" )
 
    call params%get_parameters( slkeys=parameter_list , fvalues=fcesspool_table )
 
    ! attempt to find a source of GRIDDED CESSPOOL data
    pcesspool => dat%find( "CESSPOOL_LEAKAGE" )
 
 
    ! call parameter_list%clear()
    ! call parameter_list%append( "Storm_drain_discharge" )
    ! call parameter_list%append( "Storm_drain_recharge" )
    ! call parameter_list%append( "Storm_drain_leakage" )
    !
    ! call PARAMS%get_parameters( slKeys=parameter_list , fValues=fSTORM_DRAIN_TABLE )
    !
    ! pSTORM_DRAIN => DAT%find( "STORM_DRAIN" )
    !
 
    call parameter_list%clear()
    call parameter_list%append( "Water_body_recharge" )
    call parameter_list%append( "Water_body_discharge" )
    call parameter_list%append( "Water_body_leakage" )
 
    call params%get_parameters( slkeys=parameter_list , fvalues=fwater_body_recharge_table )
 
    pwater_body_recharge => dat%find( "WATER_BODY_RECHARGE" )
 
 
    call parameter_list%clear()
    call parameter_list%append( "Water_main_recharge" )
    call parameter_list%append( "Water_main_discharge" )
    call parameter_list%append( "Water_main_leakage" )
 
    call params%get_parameters( slkeys=parameter_list , fvalues=fwater_main_table )
 
    pwater_main => dat%find( "WATER_MAIN_LEAKAGE" )
 
 
    call parameter_list%clear()
    call parameter_list%append( "Disposal_well_recharge" )
    call parameter_list%append( "Disposal_well_discharge" )
 
    call params%get_parameters( slkeys=parameter_list , fvalues=fdisposal_well_table )
 
    pdisposal_well => dat%find( "DISPOSAL_WELL_DISCHARGE" )
 
    if ( associated( pannual_recharge_rate ) ) then
 
      allocate( fannual_recharge_rate( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
    elseif ( fannual_recharge_rate_table(1) > ftinyval ) then
 
      are_lengths_equal = ( ( ubound(fannual_recharge_rate_table,1) == ubound(landuse_codes,1) )  )
 
      if ( .not. are_lengths_equal )     &
        call warn( smessage="The number of landuses does not match the number of annual direct"   &
          //" recharge rate values.", smodule=__file__, iline=__line__, lfatal=.true._c_bool )
 
      allocate( fannual_recharge_rate( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
      do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
        fannual_recharge_rate( indx ) = fannual_recharge_rate_table( landuse_index( indx ) )
      enddo
 
     endif
 
 
    if ( associated( pcesspool ) ) then
 
      allocate( fcesspool( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
    elseif ( fcesspool_table(1) > ftinyval ) then
 
      are_lengths_equal = ( ( ubound(fcesspool_table,1) == ubound(landuse_codes,1) )  )
 
      if ( .not. are_lengths_equal )     &
        call warn( smessage="The number of landuses does not match the number of cesspool discharge/leakage values.",   &
          smodule=__file__, iline=__line__, lfatal=.true._c_bool )
 
      allocate( fcesspool( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
      do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
        fcesspool( indx ) = fcesspool_table( landuse_index( indx ) )
      enddo
 
     endif
 
    ! if ( associated( pSTORM_DRAIN ) ) then
    !
    !   allocate( fSTORM_DRAIN( count( is_cell_active ) ), stat=status )
    !   call assert( status==0, "Problem allocating memory", __FILE__, __LINE__ )
    !
    ! elseif ( fSTORM_DRAIN_TABLE(1) > fTINYVAL ) then
    !
    !   are_lengths_equal = ( ( ubound(fSTORM_DRAIN_TABLE,1) == ubound(landuse_codes,1) )  )
    !
    !   if ( .not. are_lengths_equal )     &
    !     call warn( sMessage="The number of landuses does not match the number of storm drain discharge/leakage values.",   &
    !       sModule=__FILE__, iLine=__LINE__, lFatal=.true._c_bool )
    !
    !   allocate( fSTORM_DRAIN( count( is_cell_active ) ), stat=status )
    !   call assert( status==0, "Problem allocating memory", __FILE__, __LINE__ )
    !
    !   do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
    !     fSTORM_DRAIN( indx ) = fSTORM_DRAIN_TABLE( landuse_index( indx ) )
    !   enddo
    !
    !  endif
 
    if ( associated( pwater_body_recharge ) ) then
 
      allocate( fwater_body_recharge( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
    elseif ( fwater_body_recharge_table(1) > ftinyval ) then
 
      are_lengths_equal = ( ( ubound(fwater_body_recharge_table,1) == ubound(landuse_codes,1) )  )
 
      if ( .not. are_lengths_equal )     &
        call warn( smessage="The number of landuses does not match the number of water body recharge/leakage values.",   &
          smodule=__file__, iline=__line__, lfatal=.true._c_bool )
 
      allocate( fwater_body_recharge( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
      do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
        fwater_body_recharge( indx ) = fwater_body_recharge_table( landuse_index( indx ) )
      enddo
 
     endif
 
 
    if ( associated( pwater_main ) ) then
 
      allocate( fwater_main( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
    elseif ( fwater_main_table(1) > ftinyval ) then
 
      are_lengths_equal = ( ( ubound(fwater_main_table,1) == ubound(landuse_codes,1) )  )
 
      if ( .not. are_lengths_equal )     &
        call warn( smessage="The number of landuses does not match the number of water main leakage values.",   &
          smodule=__file__, iline=__line__, lfatal=.true._c_bool )
 
      allocate( fwater_main( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
      do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
        fwater_main( indx ) = fwater_main_table( landuse_index( indx ) )
      enddo
 
     endif
 
 
    if ( associated( pdisposal_well ) ) then
 
      allocate( fdisposal_well( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
    elseif ( fdisposal_well_table(1) > ftinyval ) then
 
      are_lengths_equal = ( ( ubound(fdisposal_well_table,1) == ubound(landuse_codes,1) )  )
 
      if ( .not. are_lengths_equal )     &
        call warn( smessage="The number of landuses does not match the number of discharge well values.",   &
          smodule=__file__, iline=__line__, lfatal=.true._c_bool )
 
      allocate( fdisposal_well( count( is_cell_active ) ), stat=status )
      call assert( status==0, "Problem allocating memory", __file__, __line__ )
 
      do indx=lbound( landuse_index, 1 ), ubound( landuse_index, 1 )
        fdisposal_well( indx ) = fdisposal_well_table( landuse_index( indx ) )
      enddo
 
     endif
 
    ! initialize last retrieval date to something implausibly low to trigger initial read
    ! in the calculate procedure
    call date_of_last_retrieval%parseDate("01/01/1000", __file__, __line__)
 
  end subroutine direct_net_infiltration_initialize
 
!--------------------------------------------------------------------------------------------------
 
  subroutine direct_net_infiltration_calculate( direct_net_infiltration, indx, is_cell_active, nodata_fill_value )
 
    real (c_float), intent(inout)     :: direct_net_infiltration
    integer (c_int), intent(in)       :: indx
    logical (c_bool), intent(in)      :: is_cell_active(:,:)
    real (c_float), intent(in)        :: nodata_fill_value(:,:)
 
    ! [ LOCALS ]
    real (c_float)  :: ffactor
 
    if ( .not. date_of_last_retrieval == sim_dt%curr ) then
 
      associate( dt => sim_dt%curr )
 
        if ( associated( pcesspool ) ) then
          call pcesspool%getvalues( dt )
          if ( pcesspool%lGridHasChanged ) fcesspool = pack( pcesspool%pGrdBase%rData, is_cell_active )
        endif
 
        if ( associated( pdisposal_well ) ) then
          call pdisposal_well%getvalues( dt )
          if ( pdisposal_well%lGridHasChanged ) fdisposal_well =                                      &
               pack( pdisposal_well%pGrdBase%rData, is_cell_active )
        endif
 
        ! if ( associated( pSTORM_DRAIN ) ) then
        !   call pSTORM_DRAIN%getvalues( iMonth, iDay, iYear, iJulianDay )
        !   if ( pSTORM_DRAIN%lGridHasChanged ) fSTORM_DRAIN = pack( pSTORM_DRAIN%pGrdBase%rData, is_cell_active )
        ! endif
 
        if ( associated( pwater_body_recharge ) ) then
          call pwater_body_recharge%getvalues( dt )
          if ( pwater_body_recharge%lGridHasChanged ) fwater_body_recharge =                          &
               pack( pwater_body_recharge%pGrdBase%rData, is_cell_active )
        endif
 
        if ( associated( pwater_main ) ) then
          call pwater_main%getvalues( dt )
          if ( pwater_main%lGridHasChanged ) fwater_main = pack( pwater_main%pGrdBase%rData, is_cell_active )
        endif
 
        if ( associated( pannual_recharge_rate ) ) then
          call pannual_recharge_rate%getvalues( dt )
          if ( pannual_recharge_rate%lGridHasChanged ) fannual_recharge_rate =                        &
               pack( pannual_recharge_rate%pGrdBase%rData, is_cell_active )
        endif
 
        date_of_last_retrieval = sim_dt%curr
 
      end associate
 
    endif
 
    direct_net_infiltration = 0.0_c_float
 
    if ( allocated( fcesspool ) )                                              &
      direct_net_infiltration = direct_net_infiltration + fcesspool( indx )
 
    if ( allocated( fdisposal_well ) )                                         &
      direct_net_infiltration = direct_net_infiltration + fdisposal_well( indx )
 
    if ( allocated( fwater_main ) )                                            &
      direct_net_infiltration = direct_net_infiltration + fwater_main( indx )
 
    if ( allocated( fwater_body_recharge ) )                                   &
      direct_net_infiltration = direct_net_infiltration + fwater_body_recharge( indx )
 
!    if ( allocated( fSTORM_DRAIN ) )  direct_net_infiltration = direct_net_infiltration + fSTORM_DRAIN( indx )
 
    if ( allocated( fannual_recharge_rate) )                                   &
      direct_net_infiltration = direct_net_infiltration + fannual_recharge_rate( indx ) / 365.25_c_float
 
  end subroutine direct_net_infiltration_calculate
 
end module direct_net_infiltration__gridded_data