rooting_depth__FAO56.F90

Go to the documentation of this file.

!> @file
!!  Contains a single module, \ref rooting_depth__FAO56, which
!!  provides support for dynamic rooting depth calculation
 
!! Calculate the effective root zone depth given the current stage
!! of plant growth, the soil type, and the crop type.
module rooting_depth__fao56
 
  use iso_c_binding, only              : c_short, c_int, c_float, c_double, c_bool
  use constants_and_conversions, only  : true, false 
  use fstring_list
  use fstring, only                    : operator(.containssimilar.), ascharacter
  use parameters, only                 : params
  use exceptions, only                 : assert, warn
  use crop_coefficients__fao56, only   : kcb_l, kcb_min, kcb_ini, kcb_mid, kcb_end,               &
                                         kcb_method, kcb_method_gdd, kcb_method_monthly_values,  &
                                         kcb_method_fao56, jan, dec
  implicit none
 
  private
 
  public :: initialize_rooting_depth, update_rooting_depth 
 
  logical(c_bool), allocatable :: variable_rooting_depth(:)
 
contains
 
subroutine initialize_rooting_depth( )
 
  use parameters, only        : params, params_dict
 
  integer (c_int)               :: number_of_landuses
  integer (c_int)               :: number_of_records
  integer (c_int)               :: indx
  logical (c_bool)              :: list_lengths_are_equal
  type (fstring_list_t)         :: sllist
  type (fstring_list_t)         :: sl_variable_rooting_depth
  integer (c_int), allocatable  :: landuse_table_codes(:)
  logical (c_bool), allocatable :: tempbool(:)
  character (len=31)            :: temp_str
  integer (c_int)               :: status
 
  ! create list of possible table headings to look for...
  call sllist%append( "LU_Code" )
  call sllist%append( "Landuse_Lookup_Code" )
 
  !> Determine how many landuse codes are present
  call params%get_parameters( slkeys=sllist, ivalues=landuse_table_codes )
  number_of_landuses = count( landuse_table_codes >= 0 )
  call sllist%clear()
 
 sllist = create_list("allow_variable_rooting_depth, variable_rooting_depth")
 call params%get_parameters( slkeys=sllist, slvalues=sl_variable_rooting_depth, lfatal=false )
 call sllist%clear()
 
  number_of_records = sl_variable_rooting_depth%count
  list_lengths_are_equal = ( number_of_records == number_of_landuses )
 
  print *, "INITIALIZING ROOTING DEPTH data structures:", trim(__file__), "  ", __line__
 
  if ( .not. list_lengths_are_equal ) then
 
    call warn( smessage="The number of landuses does not match the number of values supplied for the "           &
                        //"'allow_variable_rooting_depth' parameter.",                                           &
               shints="By default, all rooting depths will be allowed to vary, using the FAO-56 methodology.",   &
               smodule=__file__, iline=__line__, lfatal=false )
    allocate(tempbool(number_of_landuses), stat=status)
    tempbool = true
    call move_alloc(tempbool, variable_rooting_depth)
  
  else
 
    allocate( variable_rooting_depth( sl_variable_rooting_depth%count ), stat=status )
    call assert( status==0, "Problem allocating memory.", __file__, __line__ )
 
    do indx=1, sl_variable_rooting_depth%count
      temp_str = sl_variable_rooting_depth%get( indx )
      if ( (temp_str .containssimilar. "variable") .or. (temp_str .containssimilar. "varying")) then
        variable_rooting_depth(indx) = true
      else
        variable_rooting_depth(indx) = false
      endif
 
      print *, "SETTING 'allow_variable_rooting_depth' for landuse index "//ascharacter(indx)//" to "//trim(temp_str)
 
    enddo
  
  endif   
 
end subroutine initialize_rooting_depth
 
!------------------------------------------------------------------------------
 
!> Calculate the effective root zone depth.
!!
!! Calculate the effective root zone depth given the current stage
!! of plant growth, the soil type, and the crop type.
!!
!! @param[inout] Zr_i Daily rooting depth estimate.
!! @param[in] Zr_max The maximum rooting depth for this crop.
!! @param[in] landuse_index Index corresponding to the line number of the table
!!             that holds data for a particular landuse.
!! @param[in] Kcb current crop coefficient value for a cell.
!! @note Implemented as equation 8-1 (Annex 8), FAO-56, Allen and others.
elemental subroutine update_rooting_depth( Zr_i, Zr_max, landuse_index, Kcb )
 
  real (c_float), intent(inout)  :: zr_i
  real (c_float), intent(in)     :: zr_max
  integer (c_int), intent(in)    :: landuse_index
  real (c_float), intent(in)     :: kcb
 
  ! [ LOCALS ]
  ! 0.328 feet equals 0.1 meters, which is seems to be the standard
  ! initial rooting depth in the FAO-56 methodology
  real (c_float), parameter :: zr_min = 0.328
  real (c_float)            :: maxkcb
  real (c_float)            :: minkcb
 
  if (variable_rooting_depth(landuse_index)) then
 
    if ( kcb_method( landuse_index ) == kcb_method_monthly_values ) then
      maxkcb = maxval( kcb_l( jan:dec, landuse_index ) )
      minkcb = minval( kcb_l( jan:dec, landuse_index ) )
    else
      maxkcb = maxval( kcb_l( kcb_ini:kcb_min, landuse_index ) )
      minkcb = minval( kcb_l( kcb_ini:kcb_min, landuse_index ) )
    endif
 
 
!    if ( MinKCB > 0.49_c_float ) then
 
!      Zr_i = Zr_max
 
    if ( kcb > minkcb ) then
 
      ! scale the rooting depth in proportion to the progress within the Kcb curve...
      ! update: we are not going to reduce the rooting depth until the Kcb value has been
      !         reset to Kcb_ini
      zr_i = max(zr_i, zr_min + ( kcb - minkcb ) / ( maxkcb - minkcb ) * ( zr_max - zr_min ))
 
    else
 
      zr_i = zr_min
 
    endif
 
  else
    
    ! user has specified a constant rooting depth. set value to Zr_max
    zr_i = zr_max
 
  endif
 
end subroutine update_rooting_depth
 
end module rooting_depth__fao56