interception__bucket.F90

Go to the documentation of this file.

module interception__bucket
 
  use iso_c_binding
  use constants_and_conversions, only : true, false, asint, ftinyval
  use datetime, only                  : mmdd2doy
  use exceptions
  use parameters, only                : params
  use simulation_datetime, only       : sim_dt
  use fstring
  use fstring_list, only               : fstring_list_t
  implicit none
 
  private
 
  public :: interception_bucket_initialize, interception_bucket_calculate
  public :: bucket_interception_storage_max_growing_season
  public :: bucket_interception_storage_max_nongrowing_season
!  public :: IS_GROWING_SEASON
 
!  logical (c_bool) :: GROWING_SEASON = .true._c_bool
 
  integer (c_int), allocatable :: ilandusecodes(:)
  real (c_float), allocatable  :: interception_a_value_growing_season(:)
  real (c_float), allocatable  :: interception_b_value_growing_season(:)
  real (c_float), allocatable  :: interception_n_value_growing_season(:)
  real (c_float), allocatable  :: interception_a_value_nongrowing_season(:)
  real (c_float), allocatable  :: interception_b_value_nongrowing_season(:)
  real (c_float), allocatable  :: interception_n_value_nongrowing_season(:)
  real (c_float), allocatable  :: bucket_interception_storage_max_growing_season(:)
  real (c_float), allocatable  :: bucket_interception_storage_max_nongrowing_season(:)
 
  !> Form of the bucket interception: I = A + P*B^n
 
!  logical (c_bool), allocatable :: IS_GROWING_SEASON(:)
 
  character( len=2 ), parameter     :: date_delims = "/-"
  real (c_float), parameter    :: nodata_value = -9999._c_float
 
contains
 
  subroutine interception_bucket_initialize( active_cells )
 
    logical (c_bool), intent(in)   :: active_cells(:,:)
 
    ! [ LOCALS ]
    integer (c_int)              :: inumberoflanduses
    logical (c_bool)             :: larelengthsequal
    character (len=:), allocatable    :: stemp
    type (fstring_list_t)              :: sl_temp_list
    type (fstring_list_t)              :: sl_growing_season_begin
    type (fstring_list_t)              :: sl_growing_season_end
    character (len=32)                :: str_buffer
    real (c_float), allocatable  :: temp_values(:)
    integer (c_int)              :: indx
    integer (c_int)              :: status
 
    !> Determine how many landuse codes are present
    stemp = "LU_Code"
    call params%get_parameters( skey=stemp,                                            &
                                ivalues=ilandusecodes )
 
    inumberoflanduses = count( ilandusecodes > 0 )
 
    !> retrieve growing season interception amount: 'a' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Growing_season_interception")
    call sl_temp_list%append("Growing_season_interception_a")
    call sl_temp_list%append("Interception_growing")
    call sl_temp_list%append("Interception_a_term_growing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,                                  &
                                fvalues=temp_values,                                  &
                                lfatal=true )
 
    if (all( temp_values > ftinyval) ) then
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'a' term for use during the growing season.",              &
                   smodule=__file__, iline=__line__, lfatal=true )
 
      call move_alloc( temp_values, interception_a_value_growing_season )
 
    endif
 
    !> retrieve growing season interception amount: 'b' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Growing_season_interception_b")
    call sl_temp_list%append("Interception_growing_b_term")
    call sl_temp_list%append("Interception_b_term_growing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,                       &
                                fvalues=temp_values,                       &
                                lfatal=false )
 
    if (all( temp_values <= ftinyval) ) then
 
      allocate(interception_b_value_growing_season( ubound( ilandusecodes, 1) ), stat=status )
      interception_b_value_growing_season = 0.0_c_float
 
    else
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'b' term for use during the growing season.",              &
                   smodule=__file__, iline=__line__, lfatal=false )
 
      call move_alloc( temp_values, interception_b_value_growing_season )
 
    endif
 
    !> retrieve growing season interception amount: 'n' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Growing_season_interception_n")
    call sl_temp_list%append("Interception_growing_n_term")
    call sl_temp_list%append("Interception_n_term_growing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,                                  &
                                fvalues=temp_values,                                  &
                                lfatal=false )
 
    if (all( temp_values <= ftinyval) ) then
 
      allocate(interception_n_value_growing_season( ubound( ilandusecodes, 1) ), stat=status )
      interception_n_value_growing_season = 1.0_c_float
 
    else
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'n' term for use during the growing season.",              &
                   smodule=__file__, iline=__line__, lfatal=true )
 
      call move_alloc( temp_values, interception_n_value_growing_season )
 
    endif
 
    !> retrieve nongrowing season interception amount: 'a' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Nongrowing_season_interception")
    call sl_temp_list%append("Nongrowing_season_interception_a")
    call sl_temp_list%append("Interception_nongrowing")
    call sl_temp_list%append("Interception_a_term_nongrowing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,          &
                                fvalues=temp_values,          &
                                lfatal=true )
 
    if (all( temp_values > ftinyval) ) then
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'a' term for use during the nongrowing season.",              &
                   smodule=__file__, iline=__line__, lfatal=false )
 
      call move_alloc( temp_values, interception_a_value_nongrowing_season )
 
    endif
 
    !> retrieve nongrowing season interception amount: 'b' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Nongrowing_season_interception_b")
    call sl_temp_list%append("Interception_nongrowing_b_term")
    call sl_temp_list%append("Interception_b_term_nongrowing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,                       &
                                fvalues=temp_values,                       &
                                lfatal=false )
 
    if (all( temp_values <= ftinyval) ) then
 
      allocate(interception_b_value_nongrowing_season( ubound( ilandusecodes, 1) ), stat=status )
      interception_b_value_nongrowing_season = 0.0_c_float
 
    else
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'b' term for use during the nongrowing season.",              &
                   smodule=__file__, iline=__line__, lfatal=false )
 
      call move_alloc( temp_values, interception_b_value_nongrowing_season )
 
    endif
 
    !> retrieve nongrowing season interception amount: 'n' term
    call sl_temp_list%clear()
    call sl_temp_list%append("Nongrowing_season_interception_n")
    call sl_temp_list%append("Interception_nongrowing_n_term")
    call sl_temp_list%append("Interception_n_term_nongrowing_season")
 
    call params%get_parameters( slkeys=sl_temp_list,                                  &
                                fvalues=temp_values,                                  &
                                lfatal=false )
 
    if (all( temp_values <= ftinyval) ) then
 
      allocate(interception_n_value_nongrowing_season( ubound( ilandusecodes, 1) ), stat=status )
      interception_n_value_nongrowing_season = 1.0_c_float
 
    else
 
      larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
      if ( .not. larelengthsequal )     &
        call warn( smessage="The number of landuses does not match the number of interception values "  &
                          //"specified for the 'n' term for use during the nongrowing season.",              &
                   smodule=__file__, iline=__line__, lfatal=false )
 
      call move_alloc( temp_values, interception_n_value_nongrowing_season )
 
    endif
 
    !> retrieve interception storage max (NONGROWING)
    call sl_temp_list%clear()
    call sl_temp_list%append("Interception_storage_max_nongrowing")
    call sl_temp_list%append("Interception_storage_max_nongrowing_season")
    call sl_temp_list%append("Interception_Storage_Maximum_nongrowing")
 
    call params%get_parameters( slkeys=sl_temp_list,                                           &
                                fvalues=bucket_interception_storage_max_nongrowing_season,     &
                                lfatal=false )
 
    larelengthsequal = ( ubound(bucket_interception_storage_max_nongrowing_season,1) == ubound(ilandusecodes,1) )
 
    if ( .not. larelengthsequal ) then
      call warn( smessage="The number of landuses does not match the number of interception storage "        &
                         //"maximum values for the NONGROWING season "                                       &
                         //"('interception_storage_max_nongrowing').",                                       &
                 shints="A default value equal to the 'Growing_season_interception_a' was assigned for the"  &
                         //" maximum interception storage",   &
                 smodule=__file__, iline=__line__, lfatal=false )
      allocate(temp_values(inumberoflanduses), stat=status)
      temp_values = interception_a_value_nongrowing_season
      call move_alloc(temp_values, bucket_interception_storage_max_nongrowing_season)
    endif
 
    !> retrieve interception storage max (GROWING)
    call sl_temp_list%clear()
    call sl_temp_list%append("Interception_storage_max_growing")
    call sl_temp_list%append("Interception_storage_max_growing_season")
    call sl_temp_list%append("Interception_Storage_Maximum_growing")
 
    call params%get_parameters( slkeys=sl_temp_list,                                              &
                                fvalues=bucket_interception_storage_max_growing_season,           &
                                lfatal=false )
 
    larelengthsequal = ( ubound(bucket_interception_storage_max_growing_season,1) == ubound(ilandusecodes,1) )
 
    if ( .not. larelengthsequal ) then
      call warn( smessage="The number of landuses does not match the number of interception storage "      &
                         //"maximum values for the GROWING season "                                        &
                         //"('interception_storage_max_growing').",                                        &
                         shints="A default value equal to the 'Nongrowing_season_interception_a' was"      &
                         //" assigned for the maximum interception storage",                               &
                 smodule=__file__, iline=__line__, lfatal=false )
      allocate(temp_values(inumberoflanduses), stat=status)
      temp_values = interception_a_value_growing_season
      call move_alloc(temp_values, bucket_interception_storage_max_growing_season)
    endif
 
  end subroutine interception_bucket_initialize
 
!--------------------------------------------------------------------------------------------------
 
  elemental subroutine interception_bucket_calculate( iLanduseIndex,                                     &
                                                      fPrecip,                                           &
                                                      fFog,                                              &
                                                      fCanopy_Cover_Fraction,                            &
                                                      it_is_growing_season,                              &
                                                      fInterception )
 
    integer (c_int), intent(in)   :: ilanduseindex
    real (c_float), intent(in)    :: fprecip
    real (c_float), intent(in)    :: ffog
    real (c_float), intent(in)    :: fcanopy_cover_fraction
    logical (c_bool), intent(in)  :: it_is_growing_season
    real (c_float), intent(out)   :: finterception
 
    ! [ LOCALS ]
    real (c_float) :: fpotentialinterception
    real (c_float) :: precip_plus_fog
 
    precip_plus_fog = fprecip + ffog
 
    if ( it_is_growing_season ) then
 
      fpotentialinterception =   interception_a_value_growing_season( ilanduseindex )   ! &
!                               + INTERCEPTION_B_VALUE_GROWING_SEASON( iLanduseIndex )    &
!                               * precip_plus_fog                                         &
!                               ** INTERCEPTION_N_VALUE_GROWING_SEASON( iLanduseIndex )
 
    else
 
      fpotentialinterception =   interception_a_value_nongrowing_season( ilanduseindex )   ! &
 !                              + INTERCEPTION_B_VALUE_NONGROWING_SEASON( iLanduseIndex )    &
 !                              * precip_plus_fog                                            &
 !                              ** INTERCEPTION_N_VALUE_NONGROWING_SEASON( iLanduseIndex )
 
    endif
 
    finterception = min( fpotentialinterception, fprecip + ffog )  * fcanopy_cover_fraction
 
  end subroutine interception_bucket_calculate
 
end module interception__bucket