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(KPATCH, KI, OCANOPY, HROUGH, OAGRI_TO_GRASS, TPSNOW, &
                         hphoto, oimp_veg, oimp_z0, oimp_emis,  &
                         plaimin, ph_tree, pvegtype_patch, plai, pz0, pveg, pemis, &
                         otr_ml, pfaparc, pfapirc, plai_effc, pmus, &
                         palbnir_soil, palbvis_soil, palbuv_soil, palbnir, palbvis, palbuv, &
                         osurf_diag_albedo, ppsn, ppsng, ppsnv, ppsnv_a, &
                         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_type_snow
USE modd_snow_par,       ONLY : xemissn
USE modd_surf_par,       ONLY : xundef, nundef
!
USE modi_set_rough
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
!              -------------------------
!
INTEGER, INTENT(IN) :: kpatch
INTEGER, INTENT(IN) :: ki
LOGICAL, INTENT(IN) :: ocanopy
 CHARACTER(LEN=4), INTENT(INOUT) :: hrough
LOGICAL, INTENT(IN) :: oagri_to_grass
TYPE(surf_snow),      INTENT(INOUT) :: tpsnow  ! snow characteristics
!
 CHARACTER(LEN=3), INTENT(IN) :: hphoto
!
LOGICAL, INTENT(IN) :: oimp_veg
LOGICAL, INTENT(IN) :: oimp_z0
LOGICAL, INTENT(IN) :: oimp_emis
!
REAL, DIMENSION(:,:), INTENT(IN) :: plaimin
REAL, DIMENSION(:,:), INTENT(IN) :: ph_tree
REAL, DIMENSION(:,:,:), INTENT(IN) :: pvegtype_patch
REAL, DIMENSION(:,:), INTENT(INOUT) :: plai
REAL, DIMENSION(:,:), INTENT(INOUT) :: pz0
REAL, DIMENSION(:,:), INTENT(INOUT) :: pveg
REAL, DIMENSION(:,:), INTENT(INOUT) :: pemis
!
LOGICAL, INTENT(IN) :: otr_ml
REAL, DIMENSION(:,:), POINTER :: pfaparc
REAL, DIMENSION(:,:), POINTER :: pfapirc
REAL, DIMENSION(:,:), POINTER :: plai_effc
REAL, DIMENSION(:,:), POINTER :: pmus
!
REAL, DIMENSION(:,:), POINTER :: palbnir_soil
REAL, DIMENSION(:,:), POINTER :: palbvis_soil
REAL, DIMENSION(:,:), POINTER :: palbuv_soil
REAL, DIMENSION(:,:), POINTER :: palbnir
REAL, DIMENSION(:,:), POINTER :: palbvis
REAL, DIMENSION(:,:), POINTER :: palbuv
!
LOGICAL, INTENT(OUT) :: osurf_diag_albedo
!
REAL, DIMENSION(:,:), POINTER :: ppsn
REAL, DIMENSION(:,:), POINTER :: ppsng
REAL, DIMENSION(:,:), POINTER :: ppsnv
REAL, DIMENSION(:,:), POINTER :: ppsnv_a
!
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 :: jpatch  ! loop counter on tiles
INTEGER :: jilu     ! loop increment
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_VEG_n',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!*      1.     Roughness length option
!              -----------------------
!
 CALL set_rough(ocanopy,hrough)
!
!-------------------------------------------------------------------------------
!
!*      2.     Radiative fields and snow/flood fracion initialization:
!              -------------------------------------------------------
!
!* snow long-wave properties (not initialized in read_gr_snow)
!
 CALL init_snow_lw(xemissn,tpsnow)
!
!-------------------------------------------------------------------------------
!
!* z0 and vegetation fraction estimated from LAI if not imposed
IF (hphoto=='LAI' .OR. hphoto=='LST' .OR. hphoto=='NIT' .OR. hphoto=='NCB') THEN
  DO jpatch=1,kpatch
    DO jilu=1,ki    
      IF(plai(jilu,jpatch)/=xundef) THEN
        plai(jilu,jpatch) = max(plaimin(jilu,jpatch),plai(jilu,jpatch))
      END IF  
      IF(.NOT.oimp_z0.AND.plai(jilu,jpatch)/=xundef) THEN
        pz0(jilu,jpatch) = z0v_from_lai(plai(jilu,jpatch),ph_tree(jilu,jpatch),pvegtype_patch(jilu,:,jpatch),oagri_to_grass)
      END IF  
      IF(.NOT.oimp_veg.AND.plai(jilu,jpatch)/=xundef) THEN
        pveg(jilu,jpatch) = veg_from_lai(plai(jilu,jpatch),pvegtype_patch(jilu,:,jpatch),oagri_to_grass)
      END IF  
      IF(.NOT.oimp_emis.AND.plai(jilu,jpatch)/=xundef) THEN
        pemis(jilu,jpatch) = emis_from_veg(pveg(jilu,jpatch),pvegtype_patch(jilu,:,jpatch))
      END IF  
    END DO
  END DO
END IF
!
!-------------------------------------------------------------------------------
!
IF (otr_ml) THEN
  ALLOCATE(pfaparc(ki, kpatch))
  ALLOCATE(pfapirc(ki, kpatch))
  ALLOCATE(plai_effc(ki, kpatch))
  ALLOCATE(pmus(ki, kpatch))
  pfaparc(:,:) = 0.
  pfapirc(:,:) = 0.
  plai_effc(:,:) = 0.
  pmus(:,:) = 0.
ELSE
  ALLOCATE(pfaparc(0,0))
  ALLOCATE(pfapirc(0,0))
  ALLOCATE(plai_effc(0,0))
  ALLOCATE(pmus(0,0))
ENDIF        
!
!-------------------------------------------------------------------------------
!
!* albedo per tile and averaged albedo, emissivity and radiative temperature
!
ALLOCATE(palbnir_soil(ki,kpatch))
ALLOCATE(palbvis_soil(ki,kpatch))
ALLOCATE(palbuv_soil(ki,kpatch))
ALLOCATE(palbnir(ki,kpatch))
ALLOCATE(palbvis(ki,kpatch))
ALLOCATE(palbuv(ki,kpatch))
palbnir_soil(:,:) = xundef
palbvis_soil(:,:) = xundef
palbuv_soil(:,:) = xundef
palbnir(:,:) = xundef
palbvis(:,:) = xundef
palbuv(:,:) = xundef
!
osurf_diag_albedo = .true.
!
!* Initialization of total albedo, emissivity and snow/flood fractions
!
ALLOCATE(ppsn(ki,kpatch))
ALLOCATE(ppsng(ki,kpatch))
ALLOCATE(ppsnv(ki,kpatch))
ppsn  = 0.0
ppsng = 0.0
ppsnv = 0.0
!
IF(tpsnow%SCHEME=='EBA')THEN
   ALLOCATE(ppsnv_a(ki,kpatch))
   ppsnv_a = 0.0
ELSE
   ALLOCATE(ppsnv_a(0,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