init_from_data_teb_vegn.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 init_from_data_teb_veg_n (DTV, K, P, PEK, KDECADE, OUPDATE, OFIX, OTIME, OALB)    
!     ##############################################################
!
!!**** *CONVERT_COVER* convert surface cover classes into secondary 
!!                     physiographic variables for ISBA
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original   01/2004
!     
!!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_n, ONLY : isba_k_t, isba_p_t, isba_pe_t
!
USE modi_soil_albedo
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_isba_t), INTENT(INOUT) :: DTV
!
INTEGER,                INTENT(IN)    :: KDECADE
!
LOGICAL, INTENT(IN) :: OUPDATE
LOGICAL, INTENT(IN) :: OFIX
LOGICAL, INTENT(IN) :: OTIME
LOGICAL, INTENT(IN) :: OALB
!
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(isba_p_t), INTENT(INOUT) :: P
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:), ALLOCATABLE :: ZWG1
REAL, DIMENSION(:), ALLOCATABLE   :: ZWGSAT
!
INTEGER :: ITIME
INTEGER :: ILUOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!*    1.      TIME INITIALIZATION
!             -------------------
!
! data every month
IF (lhook) CALL dr_hook('INIT_FROM_DATA_TEB_VEG_N',0,zhook_handle)
IF (dtv%NTIME==12) THEN
  itime = (kdecade+2)/3    
ELSEIF (dtv%NTIME==1) THEN
  itime = 1
ENDIF
!
!
IF (ofix) THEN
!

  IF (SIZE(p%XH_TREE)>0) p%XH_TREE(:) = dtv%XPAR_H_TREE(:,1)
!
  p%XZ0_O_Z0H(:) = dtv%XPAR_Z0_O_Z0H(:,1)
!
!---------------------------------------------------------------------------------
!
!* soil layers
!  -----------
!
  p%XDG(:,:) = dtv%XPAR_DG(:,:,1)
!
!* cumulative root fraction
!
  IF (SIZE(p%XROOTFRAC)>0) p%XROOTFRAC(:,:) = dtv%XPAR_ROOTFRAC(:,:,1)
!
!* soil ice for runoff
!
 p%XD_ICE(:) = dtv%XPAR_DICE(:,1)
!
  IF (SIZE(p%XDMAX)>0) p%XDMAX(:) = dtv%XPAR_DMAX(:,1)

  IF (SIZE(p%XRE25)>0) p%XRE25(:) = dtv%XPAR_RE25(:,1)


ENDIF
!
!
!*    2.      SECONDARY VARIABLES
!             -------------------
!
!*    2.1     fields on natural surfaces only, taking into account patches/ 
!             -------------------------------
!
IF (otime) THEN
!
! vegetation fraction
! -------------------
!
 pek%XVEG(:) =  dtv%XPAR_VEG (:,itime,1)
!
! Leaf Aera Index
! ---------------
!
 pek%XLAI(:) = dtv%XPAR_LAI (:,itime,1)
!
! roughness length
! ----------------
!
  pek%XZ0(:) =  dtv%XPAR_Z0 (:,itime,1)
!
!emis-eco
!--------
!
  pek%XEMIS(:) =  dtv%XPAR_EMIS (:,itime,1)
!
 IF (.NOT.oupdate) THEN
!---------------------------------------------------------------------------------
! 
!* 1/Rsmin
!
  pek%XRSMIN(:) = dtv%XPAR_RSMIN(:,1)
!
!* other vegetation parameters
!
  pek%XGAMMA(:) = dtv%XPAR_GAMMA(:,1)
  pek%XWRMAX_CF(:) = dtv%XPAR_WRMAX_CF(:,1)
!
!
  pek%XRGL(:) = dtv%XPAR_RGL(:,1)
  pek%XCV(:) = dtv%XPAR_CV(:,1)
!
!---------------------------------------------------------------------------------
  pek%XALBNIR_VEG(:) = dtv%XPAR_ALBNIR_VEG(:,1,1)
  pek%XALBVIS_VEG(:) = dtv%XPAR_ALBVIS_VEG(:,1,1)
  pek%XALBUV_VEG(:)  = dtv%XPAR_ALBUV_VEG(:,1,1)
!
  IF (SIZE(pek%XGMES)>0) pek%XGMES(:) = dtv%XPAR_GMES(:,1)

  IF (SIZE(pek%XBSLAI)>0) pek%XBSLAI(:) = dtv%XPAR_BSLAI(:,1)

  IF (SIZE(pek%XSEFOLD)>0) pek%XSEFOLD(:) = dtv%XPAR_SEFOLD(:,1)

  IF (SIZE(pek%XGC)>0) pek%XGC(:) = dtv%XPAR_GC(:,1)
!
  IF (SIZE(pek%XLAIMIN)>0) pek%XLAIMIN(:) = dtv%XPAR_LAIMIN(:,1)
!
  IF (SIZE(pek%XCE_NITRO)>0) pek%XCE_NITRO(:) = dtv%XPAR_CE_NITRO(:,1)
!
  IF (SIZE(pek%XCF_NITRO)>0) pek%XCF_NITRO(:) = dtv%XPAR_CF_NITRO(:,1)
!
  IF (SIZE(pek%XCNA_NITRO)>0) pek%XCNA_NITRO(:) = dtv%XPAR_CNA_NITRO(:,1)
!
  IF (SIZE(pek%XF2I)>0) pek%XF2I(:) = dtv%XPAR_F2I(:,1)
!
  IF (SIZE(pek%LSTRESS)>0) pek%LSTRESS(:) = dtv%LPAR_STRESS(:,1)
!
 ENDIF
ENDIF
!
IF (oalb) THEN
  !
  ALLOCATE(zwgsat(SIZE(k%XALBVIS_DRY)))
  ALLOCATE(zwg1(SIZE(k%XALBVIS_DRY)))
  zwgsat(:) = 0.
  zwg1(:) = 0.
  CALL soil_albedo('DRY',zwgsat, zwg1, k, pek, "ALL" ) 
  DEALLOCATE(zwgsat,zwg1)
  !
ENDIF
!
IF (lhook) CALL dr_hook('INIT_FROM_DATA_TEB_VEG_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE init_from_data_teb_veg_n