init_teb_greenroofn.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_greenroof_n (DTCO, U, DGMTO, TOP, TVG, GRM, &
                                 hprogram,hinit,ki,ksw,psw_bands,kpatch)
!#############################################################
!
!!****  *INIT_TEB_GREENROOF_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_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_teb_veg_n, ONLY : teb_veg_options_t
USE modd_surfex_n, ONLY : teb_greenroof_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_greenroof_snow
USE modi_allocate_teb_greenroof
USE modi_abor1_sfx
USE modi_read_teb_greenroof_n
USE modi_init_veg_garden_n
USE modi_soil_albedo
USE modi_init_from_data_greenroof_n
USE modi_avg_albedo_emis_greenroof
!
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(surf_atm_t), INTENT(INOUT) :: u
TYPE(diag_misc_teb_options_t), INTENT(INOUT) :: dgmto
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(teb_veg_options_t), INTENT(INOUT) :: tvg
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
!
 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_GREENROOF_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
!*       1.     Reading of snow configuration:
!               ------------------------------
!
!* initialization of snow scheme (TSNOW defined in MODD_TEB_GREENROOF_n)
!
IF (hinit=='PRE') THEN
   CALL read_prep_greenroof_snow(hprogram,grm%TGR%CUR%TSNOW%SCHEME,grm%TGR%CUR%TSNOW%NLAYER)
!
   IF (grm%TGR%CUR%TSNOW%SCHEME.NE.'3-L' .AND. grm%TGR%CUR%TSNOW%SCHEME.NE.'CRO' &
           .AND. grm%TGRO%CISBA_GR=='DIF') THEN
    CALL abor1_sfx("INIT_TEB_GREENROOF_n: WITH CISBA_GR = DIF, CSNOW MUST BE 3-L OR CRO")
  ENDIF
  IF (lhook) CALL dr_hook('INIT_TEB_GREENROOF_N',1,zhook_handle)
  RETURN
ENDIF
!-------------------------------------------------------------------------------
!
 CALL allocate_teb_greenroof(grm%TGR, tvg, &
                             ki, grm%TGRO%NLAYER_GR)  
!
!-------------------------------------------------------------------------------
!
IF( 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_GREENROOF_N',1,zhook_handle)      
  RETURN
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       2.     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_greenroof_n(dtco, u, tvg, grm, &
                            hprogram,ypatch)
!
!
 CALL init_veg_garden_n(ki, top%LCANOPY, tvg%CROUGH, grm%TGR%CUR%TSNOW, &
                   tvg%CPHOTO, grm%TGRP%XLAIMIN, grm%TGRP%XH_TREE, grm%TGRP%XVEGTYPE, &
                   grm%TGRPE%CUR%XLAI, grm%TGRPE%CUR%XZ0, grm%TGRPE%CUR%XVEG, &
                   grm%TGRPE%CUR%XEMIS, grm%TGRO%LTR_ML_GR, grm%TGR%CUR%XFAPARC, &
                   grm%TGR%CUR%XFAPIRC, grm%TGR%CUR%XLAI_EFFC, grm%TGR%CUR%XMUS, &
                   grm%TGRP%XALBNIR_SOIL, grm%TGRP%XALBVIS_SOIL, grm%TGRP%XALBUV_SOIL, &
                   grm%TGRPE%CUR%XALBNIR, grm%TGRPE%CUR%XALBVIS, grm%TGRPE%CUR%XALBUV, &
                   dgmto%LSURF_DIAG_ALBEDO, grm%TGR%CUR%XPSN, grm%TGR%CUR%XPSNG, &
                   grm%TGR%CUR%XPSNV, grm%TGR%CUR%XPSNV_A, &
                   zdir_alb, zsca_alb, zemis, ztsrad )
!
zwg1(:) = grm%TGR%CUR%XWG(:,1)
ztg1(:) = grm%TGR%CUR%XTG(:,1)
!
IF (.NOT. grm%TGRO%LPAR_GREENROOF) THEN
  CALL soil_albedo(tvg%CALBEDO,                               &
                     grm%TGRP%XWSAT(:,1),zwg1,                       &
                     grm%TGRP%XALBVIS_DRY,grm%TGRP%XALBNIR_DRY,grm%TGRP%XALBUV_DRY,    &
                     grm%TGRP%XALBVIS_WET,grm%TGRP%XALBNIR_WET,grm%TGRP%XALBUV_WET,    &
                     grm%TGRP%XALBVIS_SOIL,grm%TGRP%XALBNIR_SOIL,grm%TGRP%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_greenroof_n(grm%DTGR, grm%TGRO, &
                                  idecade,tvg%CPHOTO,              &
                                  palbnir_soil=grm%TGRP%XALBNIR_SOIL,   &
                                  palbvis_soil=grm%TGRP%XALBVIS_SOIL,   &
                                  palbuv_soil=grm%TGRP%XALBUV_SOIL      )  
END IF
!
! 
 CALL avg_albedo_emis_greenroof(grm%TGR, &
                                tvg%CALBEDO,                                &
                               grm%TGRPE%CUR%XVEG,grm%TGRPE%CUR%XZ0,grm%TGRPE%CUR%XLAI,ztg1,  &
                               psw_bands,                              &
                               grm%TGRP%XALBNIR_VEG,grm%TGRP%XALBVIS_VEG,grm%TGRP%XALBUV_VEG,     &
                               grm%TGRP%XALBNIR_SOIL,grm%TGRP%XALBVIS_SOIL,grm%TGRP%XALBUV_SOIL,  &
                               grm%TGRPE%CUR%XEMIS, grm%TGR%CUR%TSNOW,                     &
                               grm%TGRPE%CUR%XALBNIR,grm%TGRPE%CUR%XALBVIS,grm%TGRPE%CUR%XALBUV, &
                               zdir_alb, zsca_alb,                     &
                               zemis,ztsrad                            )  
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_TEB_GREENROOF_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!

END SUBROUTINE init_teb_greenroof_n