init_teb_gardenn.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_teb_garden_n (DTCO, DGU, UG, U, DGMTO, TOP, GDM, &
                              hprogram,hinit,ki,ksw,psw_bands,kpatch)
!#############################################################
!
!!****  *INIT_TEB_GARDEN_n* - routine to initialize ISBA
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_diag_misc_teb_option_n, ONLY : diag_misc_teb_options_t
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_surfex_n, ONLY : teb_garden_model_t
!
USE modd_type_date_surf
USE modd_type_snow
!

USE modd_data_cover_par,  ONLY: nvegtype
USE modd_surf_par,        ONLY: xundef, nundef

USE modd_surf_atm,        ONLY: lcpl_arp
!
USE modi_get_luout
USE modi_read_prep_garden_snow
USE modi_allocate_teb_garden
USE modi_abor1_sfx
USE modi_read_teb_garden_n
USE modi_init_veg_garden_n
USE modi_soil_albedo
USE modi_init_from_data_grdn_n
USE modi_avg_albedo_emis_garden
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(diag_misc_teb_options_t), INTENT(INOUT) :: dgmto
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
!
 CHARACTER(LEN=6),                   INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=3),                   INTENT(IN)  :: hinit     ! choice of fields to initialize
INTEGER,                            INTENT(IN)  :: ki        ! number of points
INTEGER,                            INTENT(IN)  :: ksw       ! number of short-wave spectral bands
REAL,             DIMENSION(KSW),   INTENT(IN)  :: psw_bands ! middle wavelength of each band
INTEGER,                            INTENT(IN)  :: kpatch
!
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: iluout   ! unit of output listing file
!
INTEGER           :: idecade  ! decade of simulation
!
 CHARACTER(LEN=3) :: ypatch ! patch identificator
!
REAL, DIMENSION(KI)               :: zwg1 ! work array for surface water content
REAL, DIMENSION(KI)               :: ztg1 ! work array for surface temperature
REAL, DIMENSION(KI,KSW)           :: zdir_alb  ! direct albedo for each band
REAL, DIMENSION(KI,KSW)           :: zsca_alb  ! diffuse albedo for each band
REAL, DIMENSION(KI)               :: zemis     ! emissivity
REAL, DIMENSION(KI)               :: ztsrad    ! radiative temperature
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!*       1.     Reading of snow configuration:
!               ------------------------------
!
!* initialization of snow scheme (TSNOW defined in MODD_TEB_GARDEN_n)
!
IF (hinit=='PRE') THEN
  CALL read_prep_garden_snow(hprogram,gdm%TGD%CUR%TSNOW%SCHEME,gdm%TGD%CUR%TSNOW%NLAYER)
!
  IF (gdm%TGD%CUR%TSNOW%SCHEME.NE.'3-L' .AND. &
                gdm%TGD%CUR%TSNOW%SCHEME.NE.'CRO' .AND. gdm%TVG%CISBA=='DIF') THEN
    CALL abor1_sfx("INIT_TEB_GARDEN_n: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
  ENDIF
  IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',1,zhook_handle)
  RETURN
ENDIF
!-------------------------------------------------------------------------------
!
 CALL allocate_teb_garden(gdm%TGD, gdm%TVG, &
                          ki, gdm%TGDO%NGROUND_LAYER)  
!
!-------------------------------------------------------------------------------
!
IF( gdm%TVG%CCPSURF=='DRY' .AND. lcpl_arp ) THEN
  CALL abor1_sfx('CCPSURF=DRY must not be used with LCPL_ARP')
ENDIF
!
!-------------------------------------------------------------------------------
!
IF (hinit/='ALL') THEN
  IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',1,zhook_handle)      
  RETURN
ENDIF
!
!-------------------------------------------------------------------------------
!
!*      10.     Prognostic and semi-prognostic fields
!               -------------------------------------
!
!* allocation of urban green area variables
!
!
  ypatch='   '
  IF (top%NTEB_PATCH>1) WRITE(ypatch,fmt='(A,I1,A)') 'T',kpatch,'_'
!
  CALL read_teb_garden_n(dtco, dgu, u, gdm, &
                         hprogram,ypatch)
!
!
 CALL init_veg_garden_n(ki, top%LCANOPY, gdm%TVG%CROUGH, gdm%TGD%CUR%TSNOW, &
                   gdm%TVG%CPHOTO, gdm%TGDP%XLAIMIN, gdm%TGDP%XH_TREE, gdm%TGDP%XVEGTYPE, &
                   gdm%TGDPE%CUR%XLAI, gdm%TGDPE%CUR%XZ0, gdm%TGDPE%CUR%XVEG, gdm%TGDPE%CUR%XEMIS, &
                   gdm%TVG%LTR_ML, gdm%TGD%CUR%XFAPARC, gdm%TGD%CUR%XFAPIRC, gdm%TGD%CUR%XLAI_EFFC, &
                   gdm%TGD%CUR%XMUS, gdm%TGDP%XALBNIR_SOIL, gdm%TGDP%XALBVIS_SOIL, &
                   gdm%TGDP%XALBUV_SOIL, gdm%TGDPE%CUR%XALBNIR, gdm%TGDPE%CUR%XALBVIS, &
                   gdm%TGDPE%CUR%XALBUV, dgmto%LSURF_DIAG_ALBEDO, gdm%TGD%CUR%XPSN, &
                   gdm%TGD%CUR%XPSNG, gdm%TGD%CUR%XPSNV, gdm%TGD%CUR%XPSNV_A, &
                   zdir_alb, zsca_alb, zemis, ztsrad )
!
zwg1(:) = gdm%TGD%CUR%XWG(:,1)
ztg1(:) = gdm%TGD%CUR%XTG(:,1)
!
IF (.NOT. gdm%TGDO%LPAR_GARDEN) THEN
  CALL soil_albedo(gdm%TVG%CALBEDO,                               &
                     gdm%TGDP%XWSAT(:,1),zwg1,                       &
                     gdm%TGDP%XALBVIS_DRY,gdm%TGDP%XALBNIR_DRY,gdm%TGDP%XALBUV_DRY,    &
                     gdm%TGDP%XALBVIS_WET,gdm%TGDP%XALBNIR_WET,gdm%TGDP%XALBUV_WET,    &
                     gdm%TGDP%XALBVIS_SOIL,gdm%TGDP%XALBNIR_SOIL,gdm%TGDP%XALBUV_SOIL  )  
ELSE
  IF (top%TTIME%TDATE%MONTH /= nundef) THEN
    idecade = 3 * ( top%TTIME%TDATE%MONTH - 1 ) + min(top%TTIME%TDATE%DAY-1,29) / 10 + 1
  ELSE
    idecade = 1
  END IF
  CALL init_from_data_grdn_n(gdm%DTGD, &
                             idecade,gdm%TVG%CPHOTO,              &
                               palbnir_soil=gdm%TGDP%XALBNIR_SOIL,   &
                               palbvis_soil=gdm%TGDP%XALBVIS_SOIL,   &
                               palbuv_soil=gdm%TGDP%XALBUV_SOIL      )  
END IF
!
 CALL avg_albedo_emis_garden(gdm%TGD, gdm%TVG%CALBEDO,                  &
                             gdm%TGDPE%CUR%XVEG,gdm%TGDPE%CUR%XZ0,gdm%TGDPE%CUR%XLAI,ztg1,      &
                             psw_bands,                             &
                             gdm%TGDP%XALBNIR_VEG,gdm%TGDP%XALBVIS_VEG,gdm%TGDP%XALBUV_VEG,     &
                             gdm%TGDP%XALBNIR_SOIL,gdm%TGDP%XALBVIS_SOIL,gdm%TGDP%XALBUV_SOIL,  &
                             gdm%TGDPE%CUR%XEMIS, gdm%TGD%CUR%TSNOW,                            &
                             gdm%TGDPE%CUR%XALBNIR,gdm%TGDPE%CUR%XALBVIS,gdm%TGDPE%CUR%XALBUV,  &
                                 zdir_alb, zsca_alb,                     &
                                 zemis,ztsrad                            )  
!
!
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_TEB_GARDEN_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE init_teb_garden_n