init_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_veg_n(IO, KK, PK, PEK, DTV, &
                      OSURF_DIAG_ALBEDO, PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )  
!#############################################################
!
!!****  *INIT_VEG_n* - routine to initialize ISBA
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!
!!      B. Decharme    01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_k_t, isba_p_t, isba_pe_t
USE modd_data_isba_n, ONLY : data_isba_t
!
USE modd_type_snow
USE modd_snow_par,       ONLY : xemissn
USE modd_surf_par,       ONLY : xundef, nundef
!
USE modi_init_snow_lw
USE modi_z0v_from_lai
USE modi_veg_from_lai
USE modi_emis_from_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_k_t), INTENT(INOUT) :: KK
TYPE(isba_p_t), INTENT(INOUT) :: PK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
TYPE(data_isba_t), INTENT(INOUT) :: DTV
!
LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB
REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_OUT
REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER :: JI     ! loop increment
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_VEG_n',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!*      2.     Radiative fields and snow/flood fracion initialization:
!              -------------------------------------------------------
!
!* snow long-wave properties (not initialized in read_gr_snow)
!
 CALL init_snow_lw(xemissn,pek%TSNOW)
!
!-------------------------------------------------------------------------------
!
!* z0 and vegetation fraction estimated from LAI if not imposed
IF (io%CPHOTO=='NIT' .OR. io%CPHOTO=='NCB') THEN
  DO ji=1,pk%NSIZE_P    
    IF(pek%XLAI(ji)/=xundef) THEN
      pek%XLAI (ji) = max(pek%XLAIMIN(ji),pek%XLAI(ji))
      IF (.NOT.dtv%LIMP_Z0)   &
         pek%XZ0  (ji) = z0v_from_lai(pek%XLAI(ji),pk%XH_TREE(ji),pk%XVEGTYPE_PATCH(ji,:),io%LAGRI_TO_GRASS)
      IF (.NOT.dtv%LIMP_VEG)  &
        pek%XVEG (ji) = veg_from_lai(pek%XLAI(ji),pk%XVEGTYPE_PATCH(ji,:),io%LAGRI_TO_GRASS)
      IF (.NOT.dtv%LIMP_EMIS) &
        pek%XEMIS(ji) = emis_from_veg(pek%XVEG(ji),pk%XVEGTYPE_PATCH(ji,:))
    END IF  
  END DO
END IF
!
!-------------------------------------------------------------------------------
!
IF (io%LTR_ML) THEN
  ALLOCATE(pek%XFAPARC   (pk%NSIZE_P))
  ALLOCATE(pek%XFAPIRC   (pk%NSIZE_P))
  ALLOCATE(pek%XLAI_EFFC (pk%NSIZE_P))
  ALLOCATE(pek%XMUS      (pk%NSIZE_P))
  pek%XFAPARC   (:) = 0.
  pek%XFAPIRC   (:) = 0.
  pek%XLAI_EFFC (:) = 0.
  pek%XMUS      (:) = 0.
ELSE
  ALLOCATE(pek%XFAPARC   (0))
  ALLOCATE(pek%XFAPIRC   (0))
  ALLOCATE(pek%XLAI_EFFC (0))
  ALLOCATE(pek%XMUS      (0))
ENDIF        
!
!-------------------------------------------------------------------------------
!
!* albedo per tile and averaged albedo, emissivity and radiative temperature
!
ALLOCATE(pek%XALBNIR_SOIL(pk%NSIZE_P))
ALLOCATE(pek%XALBVIS_SOIL(pk%NSIZE_P))
ALLOCATE(pek%XALBUV_SOIL (pk%NSIZE_P))
ALLOCATE(pek%XALBNIR     (pk%NSIZE_P))
ALLOCATE(pek%XALBVIS     (pk%NSIZE_P))
ALLOCATE(pek%XALBUV      (pk%NSIZE_P))
pek%XALBNIR_SOIL(:) = xundef
pek%XALBVIS_SOIL(:) = xundef
pek%XALBUV_SOIL (:) = xundef
pek%XALBNIR     (:) = xundef
pek%XALBVIS     (:) = xundef
pek%XALBUV      (:) = xundef
!
osurf_diag_albedo = .true.
!
!* Initialization of total albedo, emissivity and snow/flood fractions
!
ALLOCATE(pek%XPSN (pk%NSIZE_P))
ALLOCATE(pek%XPSNG(pk%NSIZE_P))
ALLOCATE(pek%XPSNV(pk%NSIZE_P))
pek%XPSN  = 0.0
pek%XPSNG = 0.0
pek%XPSNV = 0.0
!
IF(pek%TSNOW%SCHEME=='EBA')THEN
   ALLOCATE(pek%XPSNV_A(pk%NSIZE_P))
   pek%XPSNV_A = 0.0
ELSE
   ALLOCATE(pek%XPSNV_A(0))
ENDIF
!
pdir_alb = xundef
psca_alb = xundef
pemis_out= xundef
ptsrad   = xundef
!
IF (lhook) CALL dr_hook('INIT_VEG_n',1,zhook_handle)
!
END SUBROUTINE init_veg_n