mode_teb_veg.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.
MODULE mode_teb_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_p_t, isba_pe_t, isba_s_t
!
IMPLICIT NONE
!
CONTAINS
!
SUBROUTINE init_if_dif(KGROUND_LAYER, PMASK, P)
!
INTEGER, INTENT(IN) :: KGROUND_LAYER
REAL, DIMENSION(:), INTENT(IN) :: PMASK
TYPE(isba_p_t), INTENT(INOUT) :: P
!
INTEGER :: JI, JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TEB_VEG:INIT_IF_DIF',0,zhook_handle)
!
WHERE(pmask(:)/=0.)
  p%NWG_LAYER(:)=kground_layer 
  p%XDG2  (:)=0.0
  p%XDROOT(:)=0.0
ENDWHERE
DO jl=kground_layer,1,-1
  DO ji=1,SIZE(pmask)
    IF(pmask(ji)/=0..AND.p%XROOTFRAC(ji,jl)>=1.0)THEN
      p%XDG2  (ji)=p%XDG(ji,jl)
      p%XDROOT(ji)=p%XDG(ji,jl)
    ENDIF
  ENDDO
ENDDO
!
IF (lhook) CALL dr_hook('MODE_TEB_VEG:INIT_IF_DIF',1,zhook_handle)
!
END SUBROUTINE init_if_dif
!
SUBROUTINE init_if_noveg(PMASK, IO, S, P, PEK)
!
REAL, DIMENSION(:), INTENT(IN) :: PMASK
TYPE(isba_options_t), INTENT(IN) :: IO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_p_t), INTENT(INOUT) :: P
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
INTEGER :: JL, JV
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TEB_VEG:INIT_IF_NOVEG',0,zhook_handle)
!
WHERE (pmask(:)==0.)
  pek%XVEG(:)=0.
  pek%XLAI(:)=0.
  pek%XRSMIN(:)=40.
  pek%XGAMMA(:)=0.
  pek%XWRMAX_CF(:)=0.2
  pek%XRGL(:)=100.
  pek%XCV(:)=2.e-5
  pek%XZ0(:)=0.013
  p%XZ0_O_Z0H(:)=10.
  pek%XALBNIR_VEG(:)=0.30
  pek%XALBVIS_VEG(:)=0.30
  pek%XALBUV_VEG(:)=0.06
  pek%XEMIS(:)=0.94
ENDWHERE  
IF (io%CPHOTO/='NON') THEN
  WHERE (pmask(:)==0.)
    pek%XGMES(:)=0.020
    pek%XBSLAI(:)=0.36
    pek%XLAIMIN(:)=0.3
    pek%XSEFOLD(:)=90*86400.
    p%XH_TREE(:)=0.
    p%XRE25(:)=3.6e-7
    pek%XGC(:)=0.00025
  END WHERE
  WHERE (pmask(:)==0.) 
    p%XDMAX(:)=0.1
    pek%XF2I(:)=0.3
  END WHERE
  IF (io%CPHOTO=='NIT' .OR. io%CPHOTO=='NCB') THEN
    WHERE (pmask(:)==0.)      
      pek%XCE_NITRO(:)=7.68
      pek%XCF_NITRO(:)=-4.33
      pek%XCNA_NITRO(:)=1.3
    END WHERE
  ENDIF
ENDIF
IF(io%CISBA/='DIF')THEN
  DO jl=1,io%NGROUND_LAYER
    WHERE (pmask(:)==0.)
      p%XDG(:,jl)=0.2*jl
    END WHERE
  ENDDO
ELSE
  WHERE (pmask(:)==0.) 
    p%XDG(:,1)=0.01
    p%XDG(:,2)=0.04
    p%XROOTFRAC(:,1)=0.
    p%XROOTFRAC(:,2)=0.
  END WHERE
  DO jl=3,io%NGROUND_LAYER
    WHERE (pmask(:)==0.)
      p%XDG(:,jl)=0.1*(jl-2)
      p%XROOTFRAC(:,jl)=0.
    END WHERE
  ENDDO       
  WHERE (pmask(:)==0.) 
    p%NWG_LAYER(:)=io%NGROUND_LAYER
    p%XDROOT   (:)=0.0
    p%XDG2     (:)=p%XDG(:,io%NGROUND_LAYER-1)
  ENDWHERE    
ENDIF  
WHERE (pmask(:)==0.) 
  p%XD_ICE(:)=0.8*p%XDG(:,2)
END WHERE  
!
IF (lhook) CALL dr_hook('MODE_TEB_VEG:INIT_IF_NOVEG',1,zhook_handle)
!
END SUBROUTINE init_if_noveg
!
END MODULE mode_teb_veg