exp_decay_soil_fr.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ##########
      SUBROUTINE exp_decay_soil_fr (HISBA, PF, PK, PC_DEPTH_RATIO)  
!     ##########################################################################
!
!!****  *EXP_DECAY_SOIL_FR*  
!!
!!    PURPOSE
!!    -------
!
!     We caculate the hydraulic coductivity decay factor for each FR-coefficients.
!     Also, we redefine the surface hydraulic coductivity at saturation for
!     convective precipitation parametrisation.
!     
!!**  METHOD
!!    ------
!
!     Direct calculation
!
!!    EXTERNAL
!!    --------
!
!     None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme     
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    17/11/03 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_p_t
!
USE modd_surf_par,ONLY : xundef
USE modd_sgh_par, ONLY : x2                                
USE modd_csts,    ONLY : xday
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=*)                  :: HISBA   ! hydrology/soil:
!                                            ! '2-L'  = single column
!                                            ! '3-L'  = root zone/baseflow layer
!                                            ! 'DIF'  = N-layer diffusion: Richard's Eq.
!
REAL, DIMENSION(:), INTENT(IN)    :: PF
!                                    PF = exponential decay factor (1/m)
!
TYPE(isba_p_t), INTENT(INOUT) :: PK
!
REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PC_DEPTH_RATIO
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PF))         :: ZD_G_TOT, ZC_DEPTH, ZKSAT_NOEXP, ZC_DEPTH_RATIO
!                                    ZD_G_TOT = depth of the soil column (m)
!                                    ZC_DEPTH = assumed as the depth where the vertical 
!                                               satured hydraulic conductivities reach
!                                               the compacted value given in Clapp and
!                                               Hornberger. (m)
!                                               For ISBA-FR, we take the root depth.
!
INTEGER :: JP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('EXP_DECAY_SOIL_FR',0,zhook_handle)
!
zd_g_tot(:) = pk%XDG(:,2)
IF(hisba=='3-L')zd_g_tot(:) = pk%XDG(:,3)
!
zksat_noexp(:) = pk%XCONDSAT(:,2)
!
zc_depth_ratio(:) = 1.
!
IF (PRESENT(pc_depth_ratio)) zc_depth_ratio(:) = pc_depth_ratio(:)
!
WHERE(zd_g_tot(:)/=xundef)
  !
  !compacted depth
  !
  zc_depth(:) = pk%XDG(:,2)*zc_depth_ratio(:)
  !ZC_DEPTH(:) = PK%XDG(:,2)
  !
  !surface hydraulic conductivity at saturation
  !
  pk%XCONDSAT(:,1) = pk%XCONDSAT(:,1)*exp(pf(:)*zc_depth(:))
  !
  !mean hydraulic conductivity at saturation over the root zone
  !   
  pk%XCONDSAT(:,2) = zksat_noexp(:)*( exp(pf(:)*zc_depth)-exp(pf(:)*(zc_depth(:)-pk%XDG(:,2))) )   &
                    /(pf(:)*pk%XDG(:,2))
  !   
  !mean hydraulic conductivity at saturation over the first soil centimeters
  !   
  pk%XKSAT_ICE(:) = zksat_noexp(:)*( exp(pf(:)*zc_depth)-exp(pf(:)*(zc_depth(:)-pk%XD_ICE(:))) )   &
                   /(pf(:)*pk%XD_ICE(:))  
  !
  !decay factor for C1 coef
  !   
  pk%XC1SAT(:) = pk%XC1SAT(:)*sqrt( exp(-pf(:)*zc_depth(:)) )
  !
  !decay factor for C2 coef 
  !
  pk%XC2REF(:)=pk%XC2REF(:)+( pk%XCONDSAT(:,2)-zksat_noexp(:) ) * xday/pk%XDG(:,2) 
  !
  !C3 coef with exponential decay in root soil layer 
  !
  pk%XC3(:,1)=pk%XC3(:,1)*( exp(pf(:)*zc_depth(:))-exp(pf(:)*(zc_depth(:)-pk%XDG(:,2))) ) / &
          (pf(:)*pk%XDG(:,2))
  !
ENDWHERE
!
IF(hisba=='3-L')THEN
  ! 
  WHERE(pk%XDG(:,2)< zd_g_tot(:).AND.pk%XDG(:,2)/=xundef)
    !           
    !  C3 coef with exponential decay in deep soil layer 
    !
    pk%XC3(:,2)=pk%XC3(:,2)*( exp(pf(:)*(zc_depth(:)-pk%XDG(:,2)))-exp(pf(:)*(zc_depth(:)-zd_g_tot(:))) )      &
                     / (pf(:)*(zd_g_tot(:)-pk%XDG(:,2)))  
    ! 
    !  decay factor for C4 coef
    !      
    pk%XC4REF(:)=pk%XC4REF(:)*( exp(pf(:)*(zc_depth(:)-pk%XDG(:,2)/x2))-exp(pf(:)*(zc_depth(:)&
                         -((pk%XDG(:,2)+zd_g_tot(:))/2.))) ) * x2/(pf(:)*zd_g_tot(:))        
    !
  ENDWHERE
  !
ENDIF
!
IF (lhook) CALL dr_hook('EXP_DECAY_SOIL_FR',1,zhook_handle)
!
END SUBROUTINE exp_decay_soil_fr