ini_data_rootfrac.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 ini_data_rootfrac( PDG, PROOTDEPTH, PROOT_EXT, PROOT_LIN,  &
                                    prootfrac, ogv                          )

!     ##########################################################################
!
!!****  *INI_DATA_ROOTFRAC*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates the soil grid configuration using a reference grid
!     Also compute the root fraction
!         
!     
!!**  METHOD
!!    ------
!
!     Direct calculation
!
!!    EXTERNAL
!!    --------
!
!     None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    Noilhan and Planton (1989)
!!    Belair (1995)
!!    Boone (2000)
!!    Boone et al. (2000)
!!    Habets et al. (2003)
!!    Decharme et al. (2011)
!!      
!!    AUTHOR
!!    ------
!!      A. Boone           * Meteo-France *
!!      new version :
!!      B. Decharme        * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original     12/04/03
!!      new version :10/08/2011
!!      P. Samuelsson  02/2012  MEB
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_surf_par, ONLY : xundef, nundef
USE modd_isba_par, ONLY : noptimlayer, xoptimgrid
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,    DIMENSION(:,:,:), INTENT(IN) :: pdg         ! depth of base of soil layers (m)
REAL,    DIMENSION(:,:),   INTENT(IN) :: prootdepth  ! effective root depth         (m)
REAL, DIMENSION(:,:), INTENT(IN)     :: proot_ext
REAL, DIMENSION(:,:), INTENT(IN)     :: proot_lin
LOGICAL, OPTIONAL, INTENT(IN)        :: ogv
!
REAL, DIMENSION(:,:,:), INTENT(OUT)  :: prootfrac
!
!*      0.2    declarations of local variables
!
REAL               :: zlog1, zlog2
REAL               :: zjackson ! Jackson (1996) formulation for cumulative root fraction
REAL               :: zunif    ! linear formulation for cumulative root fraction
REAL               :: zrootfrgv ! Fraction of patch root depth given to
!                               ! grass root depth for understory ground vegetation.
!                               ! =1 for non-understory vegetation

!
INTEGER            :: ini,inl,ipatch
INTEGER            :: jj,jl,jpatch
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!        0.     Initialization
!               --------------
!
IF (lhook) CALL dr_hook('INI_DATA_ROOTFRAC',0,zhook_handle)
!
ini    = SIZE(pdg,1)
inl    = SIZE(pdg,2)
ipatch = SIZE(pdg,3)
!
zrootfrgv  = 1.0
IF (present(ogv)) THEN
  IF(ogv) zrootfrgv  = 0.5
ENDIF
!
prootfrac(:,:,:) = xundef
!
DO jpatch=1,ipatch
  DO jj=1,ini
    !
    IF ( prootdepth(jj,jpatch)/=xundef .AND. prootdepth(jj,jpatch)/=0.0 ) THEN 
      !
      DO jl=1,inl                
        zlog1    = 100. * log(proot_ext(jj,jpatch)) * pdg(jj,jl,jpatch)
        zlog2    = 100. * log(proot_ext(jj,jpatch)) * zrootfrgv * prootdepth(jj,jpatch)
        zjackson = min(1.0,(1.0-exp(zlog1))/(1.0-exp(zlog2)))
        zunif    = min(1.0,(pdg(jj,jl,jpatch)/zrootfrgv/prootdepth(jj,jpatch))) 
        prootfrac(jj,jl,jpatch) =      proot_lin(jj,jpatch)  * zunif    &
                                   + (1.0-proot_lin(jj,jpatch)) * zjackson
      ENDDO
!       No vegetation case                                    
    ELSE
      prootfrac(jj,:,jpatch) = 0.0
    ENDIF
    !
  ENDDO
ENDDO     
!
IF (lhook) CALL dr_hook('INI_DATA_ROOTFRAC',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE ini_data_rootfrac