garden_soil_depth.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 garden_soil_depth(HNVEG,HLVEG,HHVEG,PNVEG,PLVEG,PHVEG,PDG)
!     #########################################
!
!!****  *GARDEN_SOIL_DEPTH* - routine to initialise garden soil depth from data 
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2011 
!!      R. Alkama  : Add 7 new vegtype (19 rather than 12)
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_isba_par,          ONLY : xoptimgrid, noptimlayer
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=3)                   :: hnveg  ! type of no   vegetation
 CHARACTER(LEN=3)                   :: hlveg  ! type of low  vegetation
 CHARACTER(LEN=3)                   :: hhveg  ! type of high vegetation
REAL, DIMENSION(:),     INTENT(IN) :: pnveg  ! fraction of no   vegetation
REAL, DIMENSION(:),     INTENT(IN) :: plveg  ! fraction of low  vegetation
REAL, DIMENSION(:),     INTENT(IN) :: phveg  ! fraction of high vegetation
REAL, DIMENSION(:,:,:), INTENT(OUT):: pdg    ! soil depth
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(PDG,1),SIZE(PDG,2),3) :: zdata_dg
INTEGER                          :: jl, ji
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GARDEN_SOIL_DEPTH',0,zhook_handle)

IF (SIZE(pdg,2)<=3) THEN

  zdata_dg(:,1,:) = 0.01
  zdata_dg(:,2,:) = 1.50
  IF(hhveg=='TEBD')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='BONE')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='TRBE')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='TRBD')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='TEBE')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='TENE')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='BOBD')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='BOND')  zdata_dg(:,2,1)= 2.0
  IF(hhveg=='SHRB')  zdata_dg(:,2,1)= 2.0
  IF(hnveg=='NO  ')  zdata_dg(:,2,3)= 0.5
  IF(hnveg=='ROCK')  zdata_dg(:,2,3)= 0.5
  IF(hnveg=='SNOW')  zdata_dg(:,2,3)= 0.5

  IF (SIZE(pdg,2)==3) THEN
    zdata_dg(:,3,:) = 2.00
    IF(hhveg=='TEBD')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='BONE')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='TRBE')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='TRBD')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='TEBE')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='TENE')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='BOBD')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='BOND')  zdata_dg(:,3,1)= 3.0
    IF(hhveg=='SHRB')  zdata_dg(:,3,1)= 3.0
    IF(hnveg=='NO  ')  zdata_dg(:,3,3)= 1.0
    IF(hnveg=='ROCK')  zdata_dg(:,3,3)= 1.0
    IF(hnveg=='SNOW')  zdata_dg(:,3,3)= 1.0
  ENDIF

ELSEIF (SIZE(pdg,2)<=noptimlayer) THEN

  DO ji=1,SIZE(pdg,1)
    DO jl=1,3
      zdata_dg(ji,:,jl) = xoptimgrid(:)
    ENDDO
  ENDDO
 
ELSE 

  CALL abor1_sfx("GARDEN_SOIL_DEPTH: WITH MORE THAN 14 SOIL LAYERS, "//&
     "without ecoclimap, garden cannot run")

ENDIF
!
DO JL=1,SIZE(PDG,2)
 PDG(:,JL,1) =   ZDATA_DG(:,JL,1)*PHVEG(:)   &
               + ZDATA_DG(:,JL,2)*PLVEG(:)   &
               + ZDATA_DG(:,JL,3)*PNVEG(:)  
END DO
!
IF (LHOOK) CALL DR_HOOK('GARDEN_SOIL_DEPTH',1,ZHOOK_HANDLE)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE GARDEN_SOIL_DEPTH