cbl_fwsoil.F90 Source File


This file depends on

sourcefile~~cbl_fwsoil.f90~~EfferentGraph sourcefile~cbl_fwsoil.f90 cbl_fwsoil.F90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cbl_fwsoil.f90->sourcefile~cable_common.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~cbl_fwsoil.f90->sourcefile~cable_define_types.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90

Files dependent on this one

sourcefile~~cbl_fwsoil.f90~~AfferentGraph sourcefile~cbl_fwsoil.f90 cbl_fwsoil.F90 sourcefile~cbl_dryleaf.f90 cbl_dryLeaf.F90 sourcefile~cbl_dryleaf.f90->sourcefile~cbl_fwsoil.f90 sourcefile~cable_canopy.f90 cable_canopy.F90 sourcefile~cable_canopy.f90->sourcefile~cbl_dryleaf.f90 sourcefile~cbl_model_driver_offline.f90 cbl_model_driver_offline.F90 sourcefile~cbl_model_driver_offline.f90->sourcefile~cable_canopy.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

MODULE cbl_fwsoil_module

IMPLICIT NONE

PUBLIC :: fwsoil_calc_std
PUBLIC :: fwsoil_calc_non_linear
PUBLIC :: fwsoil_calc_Lai_Ktaul
PUBLIC :: fwsoil_calc_sli
PRIVATE

CONTAINS

SUBROUTINE fwsoil_calc_std(fwsoil, soil, ssnow, veg)
    USE cable_def_types_mod
    USE cable_common_module, ONLY : cable_user
    TYPE (soil_snow_type), INTENT(INOUT):: ssnow
    TYPE (soil_parameter_type), INTENT(INOUT)   :: soil
    TYPE (veg_parameter_type), INTENT(INOUT)    :: veg
    REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond
    REAL, DIMENSION(mp) :: rwater ! soil water availability

    !note even though swilt_vec is defined in default model it is r_2
    !and even using real(_vec) gives results different from trunk (rounding
    !errors)

    IF (.NOT.cable_user%gw_model) THEN

       rwater = MAX(1.0e-9,                                                    &
            SUM(veg%froot * MAX(1.0e-9,MIN(1.0, REAL(ssnow%wb) -                   &
            SPREAD(soil%swilt, 2, ms))),2) /(soil%sfc-soil%swilt))

    ELSE
       rwater = MAX(1.0e-9,                                                    &
            SUM(veg%froot * MAX(1.0e-9,MIN(1.0, REAL((ssnow%wbliq -                 &
            soil%swilt_vec)/(soil%sfc_vec-soil%swilt_vec)) )),2) )

    ENDIF

    ! Remove vbeta #56
    IF(cable_user%GS_SWITCH == 'medlyn') THEN
       fwsoil = MAX(1.0e-4,MIN(1.0, rwater))
    ELSE
       fwsoil = MAX(1.0e-9,MIN(1.0, veg%vbeta * rwater))
    ENDIF


  END SUBROUTINE fwsoil_calc_std

  ! ------------------------------------------------------------------------------

  SUBROUTINE fwsoil_calc_non_linear(fwsoil, soil, ssnow, veg)
    USE cable_def_types_mod
    TYPE (soil_snow_type), INTENT(INOUT):: ssnow
    TYPE (soil_parameter_type), INTENT(INOUT)   :: soil
    TYPE (veg_parameter_type), INTENT(INOUT)    :: veg
    REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond
    REAL, DIMENSION(mp) :: rwater ! soil water availability
    REAL, DIMENSION(mp,3)          :: xi, ti, si
    INTEGER :: j

    rwater = MAX(1.0e-9,                                                    &
         SUM(veg%froot * MAX(0.0,MIN(1.0, REAL(ssnow%wb) -                   &
         SPREAD(soil%swilt, 2, ms))),2) /(soil%sfc-soil%swilt))

    fwsoil = 1.

    rwater = soil%swilt + rwater * (soil%sfc-soil%swilt)

    xi(:,1) = soil%swilt
    xi(:,2) = soil%swilt + (soil%sfc - soil%swilt)/2.0
    xi(:,3) = soil%sfc

    ti(:,1) = 0.
    ti(:,2) = 0.9
    ti(:,3) = 1.0

    si(:,1) = (rwater - xi(:,2)) / ( xi(:,1) - xi(:,2)) *                       &
         (rwater - xi(:,3)) / ( xi(:,1) - xi(:,3))

    si(:,2) = (rwater - xi(:,1)) / ( xi(:,2) - xi(:,1)) *                       &
         (rwater - xi(:,3)) / ( xi(:,2) - xi(:,3))

    si(:,3) = (rwater - xi(:,1)) / ( xi(:,3) - xi(:,1)) *                       &
         (rwater - xi(:,2)) / ( xi(:,3) - xi(:,2))

    DO j=1,mp
       IF (rwater(j) < soil%sfc(j) - 0.02)                                      &
            fwsoil(j) = MAX(0.,MIN(1., ti(j,1)*si(j,1) +                          &
            ti(j,2)*si(j,2) + ti(j,3)*si(j,3)))

    ENDDO

  END SUBROUTINE fwsoil_calc_non_linear

  ! ------------------------------------------------------------------------------

  ! ypw 19/may/2010 soil water uptake efficiency (see Lai and Ktaul 2000)
  SUBROUTINE fwsoil_calc_Lai_Ktaul(fwsoil, soil, ssnow, veg)
    USE cable_def_types_mod
    TYPE (soil_snow_type), INTENT(INOUT):: ssnow
    TYPE (soil_parameter_type), INTENT(INOUT)   :: soil
    TYPE (veg_parameter_type), INTENT(INOUT)    :: veg
    REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond
    INTEGER   :: ns
    REAL, PARAMETER ::rootgamma = 0.01   ! (19may2010)
    REAL, DIMENSION(mp)  :: dummy, normFac
    !--- local level dependent rwater
    REAL, DIMENSION(mp,ms)  :: frwater

    fwsoil(:) = 0.0
    normFac(:) = 0.0

    DO ns=1,ms

       dummy(:) = rootgamma/MAX(1.0e-3_r_2,ssnow%wb(:,ns)-soil%swilt(:))

       frwater(:,ns) = MAX(1.0e-4_r_2,((ssnow%wb(:,ns)-soil%swilt(:))/soil%ssat(:)) &
            ** dummy)

       fwsoil(:) = MIN(1.0,MAX(fwsoil(:),frwater(:,ns)))

       normFac(:) = normFac(:) + frwater(:,ns) * veg%froot(:,ns)

    ENDDO

  END SUBROUTINE fwsoil_calc_Lai_Ktaul

  ! ------------------------------------------------------------------------------
  SUBROUTINE fwsoil_calc_sli(fwsoil, soil, ssnow, veg)
    USE cable_def_types_mod
    TYPE (soil_snow_type), INTENT(INOUT):: ssnow
    TYPE (soil_parameter_type), INTENT(INOUT)   :: soil
    TYPE (veg_parameter_type), INTENT(INOUT)    :: veg
    REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond
    REAL, DIMENSION(mp,ms):: tmp2d1, tmp2d2, delta_root, alpha2a_root, alpha2_root
    ! Lai and Katul formulation for root efficiency function  vh 17/07/09
    alpha2a_root = MAX(ssnow%wb-soil%swilt_vec, 0.001_r_2)/(soil%ssat_vec)
    tmp2d1 = ssnow%wb -soil%swilt_vec
    tmp2d2 = SPREAD(veg%gamma,2,ms)/tmp2d1*LOG(alpha2a_root)
    WHERE ((tmp2d1>0.001) .AND. (tmp2d2 > -10.0))
       alpha2_root = EXP(tmp2d2)
    ELSEWHERE
       alpha2_root = 0.0
    ENDWHERE

    WHERE (veg%froot>0.0)
       delta_root = 1.0
    ELSEWHERE
       delta_root = 0.0
    ENDWHERE

    fwsoil  = MAXVAL(alpha2_root*delta_root, 2)
    fwsoil  = MAX(0.0, fwsoil)

  END SUBROUTINE fwsoil_calc_sli

 
END MODULE cbl_fwsoil_module