init_tebn.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_n (DTCO, DGU, UG, U, CHI, DTI, I, &
                             tm, gdm, grm, dst, slt, &
                                  hprogram,hinit,                            &
                                 ki,ksv,ksw,                                &
                                 hsv,pco2,prhoa,                            &
                                 pzenith,pazim,psw_bands,pdir_alb,psca_alb, &
                                 pemis,ptsrad,ptsurf,                       &
                                 kyear, kmonth,kday, ptime,                 &
                                 hatmfile,hatmfiletype,                     &
                                 htest                                      )  
!     #############################################################
!
!!****  *INIT_TEB_n* - routine to initialize TEB
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003
!!      G. Pigeon   09/2012: add ROUGH_WALL/ROUGH_ROOF/CH_BEM for conv. coef.
!!      B. Decharme  04/2013 new coupling variables
!!                           delete CTOPREG option (never used)
!-------------------------------------------------------------------------------
!
!*       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_ch_isba_n, ONLY : ch_isba_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_n, ONLY : isba_t
USE modd_surfex_n, ONLY : teb_model_t
USE modd_surfex_n, ONLY : teb_garden_model_t
USE modd_surfex_n, ONLY : teb_greenroof_model_t
USE modd_dst_n, ONLY : dst_t
USE modd_slt_n, ONLY : slt_t
!
USE modd_io_surf_asc,ONLY: cmask
USE modd_snow_par, ONLY : xemissn
!
USE modd_read_namelist, ONLY : lnam_read
!
USE modd_chs_aerosol,     ONLY: lvarsigi, lvarsigj
USE modd_dst_surf,        ONLY: lvarsig_dst, ndstmde, ndst_mdebeg, lrgfix_dst 
USE modd_slt_surf,        ONLY: lvarsig_slt, nsltmde, nslt_mdebeg, lrgfix_slt
USE modd_surf_par,        ONLY: xundef, nundef
!
USE modi_init_io_surf_n
USE modi_default_ch_dep
USE modi_default_teb
USE modi_default_diag_teb
USE modi_read_default_teb_n
USE modi_read_teb_conf_n
USE modi_prep_ctrl_teb
USE modi_read_teb_n
USE modi_read_pgd_teb_n
USE modi_convert_teb
USE modi_convert_patch_teb
USE modi_init_snow_lw
USE modi_averaged_tsrad_teb
USE modi_averaged_albedo_teb
USE modi_diag_teb_init_n
USE modi_diag_misc_teb_init_n
USE modi_end_io_surf_n
USE modi_get_luout
USE modi_read_surf
USE modi_read_prep_teb_snow
USE modi_read_teb_date
USE modi_read_nam_prep_teb_n
USE modi_init_chemical_n
USE modi_garden_properties
USE modi_hvac_autosize
USE modi_goto_wrapper_teb_patch
!
USE modi_init_teb_garden_n
USE modi_init_teb_garden_pgd_n
USE modi_init_teb_veg_options_n
USE modi_teb_morpho
USE modi_init_bem_n
USE modi_init_teb_greenroof_n
USE modi_init_teb_greenroof_pgd_n
USE modi_greenroof_properties
USE modi_read_pgd_teb_irrig_n
!
USE modi_read_cover_garden
USE modi_abor1_sfx
USE modi_read_teb_canopy_n
USE modi_set_surfex_filein
!
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(ch_isba_t), INTENT(INOUT) :: chi
TYPE(data_isba_t), INTENT(INOUT) :: dti
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(teb_model_t), INTENT(INOUT) :: tm
TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
TYPE(dst_t), INTENT(INOUT) :: dst
TYPE(slt_t), INTENT(INOUT) :: slt
!
 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)  :: ksv         ! number of scalars
INTEGER,                            INTENT(IN)  :: ksw         ! number of short-wave spectral bands
 CHARACTER(LEN=6), DIMENSION(KSV),   INTENT(IN)  :: hsv         ! name of all scalar variables
REAL,             DIMENSION(KI),    INTENT(IN)  :: pco2        ! CO2 concentration (kg/m3)
REAL,             DIMENSION(KI),    INTENT(IN)  :: prhoa       ! air density
REAL,             DIMENSION(KI),    INTENT(IN)  :: pzenith     ! solar zenithal angle
REAL,             DIMENSION(KI),    INTENT(IN)  :: pazim       ! solar azimuthal angle (rad from N, clock)
REAL,             DIMENSION(KSW),   INTENT(IN)  :: psw_bands   ! middle wavelength of each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: pdir_alb    ! direct albedo for each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: psca_alb    ! diffuse albedo for each band
REAL,             DIMENSION(KI),    INTENT(OUT) :: pemis       ! emissivity
REAL,             DIMENSION(KI),    INTENT(OUT) :: ptsrad      ! radiative temperature
REAL,             DIMENSION(KI),    INTENT(OUT) :: ptsurf      ! surface effective temperature         (K)
INTEGER,                            INTENT(IN)  :: kyear       ! current year (UTC)
INTEGER,                            INTENT(IN)  :: kmonth      ! current month (UTC)
INTEGER,                            INTENT(IN)  :: kday        ! current day (UTC)
REAL,                               INTENT(IN)  :: ptime       ! current time since
                                                               !  midnight (UTC, s)
!
 CHARACTER(LEN=28),                  INTENT(IN)  :: hatmfile    ! atmospheric file name
 CHARACTER(LEN=6),                   INTENT(IN)  :: hatmfiletype! atmospheric file type
 CHARACTER(LEN=2),                   INTENT(IN)  :: htest       ! must be equal to 'OK'
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                         :: ilu              ! sizes of TEB arrays
INTEGER                         :: iluout           ! unit of output listing file
INTEGER                         :: iresp            ! return code
!
INTEGER                         :: iswb             ! number of shortwave spectral bands
INTEGER                         :: jswb             ! loop on shortwave spectral bands
!
REAL                            :: zdef_road_dir    ! default raod direction
REAL, DIMENSION(:), ALLOCATABLE :: zdir_alb         ! direct town albedo
REAL, DIMENSION(:), ALLOCATABLE :: zsca_alb         ! diffuse town albedo
!
!              local variables for urban green areas
REAL, DIMENSION(KI,KSW)         :: zdir_sw          ! direct  SW for each band
REAL, DIMENSION(KI,KSW)         :: zsca_sw          ! diffuse SW for each band
REAL, DIMENSION(KI)             :: zemis_garden     ! emissivity
REAL, DIMENSION(KI)             :: zalb_garden      ! albedo
REAL, DIMENSION(KI)             :: zts_garden       ! radiative temperature
!
!              local variables for urban greenroofs
REAL, DIMENSION(KI)             :: zemis_greenroof     ! emissivity
REAL, DIMENSION(KI)             :: zalb_greenroof      ! albedo
REAL, DIMENSION(KI)             :: zts_greenroof       ! radiative temperature
!
INTEGER                         :: jpatch
INTEGER                         :: iversion, ibugfix

REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
IF (lhook) CALL dr_hook('INIT_TEB_N',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
IF (htest/='OK') THEN
  CALL abor1_sfx('INIT_TEBN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
!         Other little things
!
pdir_alb = xundef
psca_alb = xundef
pemis    = xundef
ptsrad   = xundef
ptsurf   = xundef
!
tm%DGMTO%LSURF_EVAP_BUDGET = .false.
!
IF (lnam_read) THEN
 !
 !*       0.     Defaults
 !               --------
 !
 !        0.1. Hard defaults
 !      
 CALL default_teb(tm%TOP%CZ0H,tm%TOP%XTSTEP,tm%TOP%XOUT_TSTEP, tm%TOP%CCH_BEM, &
                  tm%T%CUR%XDT_RES, tm%T%CUR%XDT_OFF)
 CALL default_ch_dep(tm%CHT%CCH_DRY_DEP)
 CALL default_diag_teb(tm%DGT%N2M,tm%DGT%LSURF_BUDGET,tm%DGT%L2M_MIN_ZS,tm%DGT%LRAD_BUDGET,&
                       tm%DGT%LCOEF,tm%DGT%LSURF_VARS,tm%DGMTO%LSURF_MISC_BUDGET,&
                       tm%DGMTO%LSURF_DIAG_ALBEDO,tm%DGUT%LUTCI,tm%DGT%LPGD,&
                       tm%DGT%LPGD_FIX,tm%DGT%XDIAG_TSTEP)  
!
ENDIF
!
!        0.2. Defaults from file header
!    
 CALL read_default_teb_n(tm%CHT, tm%DGMTO, tm%DGT, tm%DGUT, grm%TGRO, tm%T, tm%TOP, &
                         hprogram)
!
!*       1.     Reading of configuration:
!               -------------------------
!
 CALL read_teb_conf_n(tm%CHT, tm%DGMTO, tm%DGT, tm%DGUT, tm%T, tm%TOP, &
                      hprogram)
!
!* initialization of snow scheme
!
IF (hinit=='PRE') THEN
  DO jpatch=1,tm%TOP%NTEB_PATCH
    CALL goto_wrapper_teb_patch(tm%B, tm%DGCT, tm%DGMT, tm%T, gdm%TGD, gdm%TGDPE, &
                                grm%TGR, grm%TGRPE, jpatch)
    CALL read_prep_teb_snow(hprogram,tm%T%CUR%TSNOW_ROOF%SCHEME,tm%T%CUR%TSNOW_ROOF%NLAYER, &
                                     tm%T%CUR%TSNOW_ROAD%SCHEME,tm%T%CUR%TSNOW_ROAD%NLAYER)
  END DO
ENDIF
!
!*       2.     Cover fields and grid:
!               ---------------------
!* date
!
SELECT CASE (hinit)
  CASE ('PGD')
    tm%TOP%TTIME%TDATE%YEAR = nundef
    tm%TOP%TTIME%TDATE%MONTH= nundef
    tm%TOP%TTIME%TDATE%DAY  = nundef
    tm%TOP%TTIME%TIME       = xundef

  CASE ('PRE')
    CALL prep_ctrl_teb(tm%DGT%N2M,tm%DGT%LSURF_BUDGET,tm%DGT%L2M_MIN_ZS,tm%DGT%LRAD_BUDGET,&
                       tm%DGT%LCOEF,tm%DGT%LSURF_VARS,tm%DGMTO%LSURF_EVAP_BUDGET,&
                       tm%DGMTO%LSURF_MISC_BUDGET,tm%DGUT%LUTCI,iluout )           
    IF (lnam_read) CALL read_nam_prep_teb_n(hprogram)   
    CALL read_teb_date(&
                       hprogram,hinit,iluout,hatmfile,hatmfiletype,kyear,kmonth,kday,ptime,tm%TOP%TTIME)

  CASE default
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')
    CALL read_surf(&
                   hprogram,'DTCUR',tm%TOP%TTIME,iresp)
    CALL end_io_surf_n(hprogram)
END SELECT
!
!-----------------------------------------------------------------------------------------------------
! READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
!         Initialisation for IO
!
 CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')
!
 CALL read_surf(&
                   hprogram,'VERSION',iversion,iresp)
 CALL read_surf(&
                   hprogram,'BUG',ibugfix,iresp)
!
!         Reading of the fields
!
 CALL read_cover_garden(&
                        hprogram,tm%TOP%LGARDEN)
!
 CALL read_pgd_teb_n(dtco, u, tm, &
                     hprogram)
!
 CALL end_io_surf_n(hprogram)
! 
!*        Fraction of each patch in the grid mesh
!
ilu = SIZE(tm%TOP%XCOVER,1)
!
ALLOCATE(tm%TOP%XTEB_PATCH(ilu,tm%TOP%NTEB_PATCH))
 CALL convert_teb(tm%TOP, &
                  tm%TOP%XCOVER,tm%TOP%XTEB_PATCH)
!
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')
!
 CALL read_surf(&
                   hprogram,'VERSION',iversion,iresp)
 CALL read_surf(&
                   hprogram,'BUG',ibugfix,iresp)
!
!* reads what is the option defined for road orientations & walls
!
IF (hinit=='ALL') THEN
  tm%TOP%CROAD_DIR='UNIF'
  tm%TOP%CWALL_OPT='UNIF'
  IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
    CALL read_surf(&
                   hprogram,'ROAD_DIR',tm%TOP%CROAD_DIR,iresp)
    CALL read_surf(&
                   hprogram,'WALL_OPT',tm%TOP%CWALL_OPT,iresp)
  END IF
END IF
 CALL end_io_surf_n(hprogram)
!-----------------------------------------------------------------------------------
!
!*              LOOP ON TEB PATCHES
!               -------------------
!
DO jpatch=1,tm%TOP%NTEB_PATCH

  CALL goto_wrapper_teb_patch(tm%B, tm%DGCT, tm%DGMT, tm%T, &
                              gdm%TGD, gdm%TGDPE, grm%TGR, grm%TGRPE, jpatch)
  !-----------------------------------------------------------------------------------
  !
  !*       3.     Physiographic data fields from land cover:
  !               -----------------------------------------
  !
  ALLOCATE(tm%T%CUR%XZ0_TOWN     (ilu))
  ALLOCATE(tm%T%CUR%XALB_ROOF    (ilu))
  ALLOCATE(tm%T%CUR%XEMIS_ROOF   (ilu))
  ALLOCATE(tm%T%CUR%XALB_ROAD    (ilu))
  ALLOCATE(tm%T%CUR%XEMIS_ROAD   (ilu))
  ALLOCATE(tm%T%CUR%XALB_WALL    (ilu))
  ALLOCATE(tm%T%CUR%XEMIS_WALL   (ilu))
  ALLOCATE(tm%T%CUR%XBLD         (ilu))
  ALLOCATE(tm%T%CUR%XROAD_DIR    (ilu))
  ALLOCATE(tm%T%CUR%XROAD        (ilu))
  ALLOCATE(tm%T%CUR%XBLD_HEIGHT  (ilu))
  ALLOCATE(tm%T%CUR%XWALL_O_HOR  (ilu))
  ALLOCATE(tm%T%CUR%XCAN_HW_RATIO(ilu))
  ALLOCATE(tm%T%CUR%XROAD_O_GRND(ilu))
  ALLOCATE(tm%T%CUR%XGARDEN_O_GRND(ilu))
  ALLOCATE(tm%T%CUR%XWALL_O_GRND(ilu))
  ALLOCATE(tm%T%CUR%XWALL_O_BLD(ilu))
  ALLOCATE(tm%T%CUR%XH_TRAFFIC   (ilu))
  ALLOCATE(tm%T%CUR%XLE_TRAFFIC  (ilu))
  ALLOCATE(tm%T%CUR%XH_INDUSTRY  (ilu))
  ALLOCATE(tm%T%CUR%XLE_INDUSTRY (ilu))
  ALLOCATE(tm%T%CUR%XHC_ROOF     (ilu,tm%TOP%NROOF_LAYER))
  ALLOCATE(tm%T%CUR%XTC_ROOF     (ilu,tm%TOP%NROOF_LAYER))
  ALLOCATE(tm%T%CUR%XD_ROOF      (ilu,tm%TOP%NROOF_LAYER))
  ALLOCATE(tm%T%CUR%XHC_ROAD     (ilu,tm%TOP%NROAD_LAYER))
  ALLOCATE(tm%T%CUR%XTC_ROAD     (ilu,tm%TOP%NROAD_LAYER))
  ALLOCATE(tm%T%CUR%XD_ROAD      (ilu,tm%TOP%NROAD_LAYER))
  ALLOCATE(tm%T%CUR%XHC_WALL     (ilu,tm%TOP%NWALL_LAYER))
  ALLOCATE(tm%T%CUR%XTC_WALL     (ilu,tm%TOP%NWALL_LAYER))
  ALLOCATE(tm%T%CUR%XD_WALL      (ilu,tm%TOP%NWALL_LAYER))
  ALLOCATE(tm%T%CUR%XROUGH_ROOF      (ilu))
  ALLOCATE(tm%T%CUR%XROUGH_WALL      (ilu))
  ALLOCATE(tm%T%CUR%XRESIDENTIAL     (ilu))
  ALLOCATE(tm%T%CUR%XGREENROOF       (ilu))
  ALLOCATE(tm%T%CUR%XGARDEN          (ilu))
  ALLOCATE(tm%TPN%XEMIS_PANEL      (ilu))
  ALLOCATE(tm%TPN%XALB_PANEL       (ilu))
  ALLOCATE(tm%TPN%XEFF_PANEL       (ilu))
  ALLOCATE(tm%TPN%XFRAC_PANEL      (ilu))
  !
  tm%T%CUR%XROAD_DIR(:) = 0.
  tm%T%CUR%XROAD    (:) = 0.
  !
  zdef_road_dir = 0.
  IF (tm%TOP%CROAD_DIR/='UNIF') THEN
    !* road direction if not specified by the user depends on patch number
    !  First patch has a Notrh-South road. Other patches have roads spaced by
    !  regular angles
    zdef_road_dir = 180. * float(jpatch-1) / float(tm%TOP%NTEB_PATCH)
  END IF
  !
  CALL convert_patch_teb(tm%BDD, tm%DTB, dtco, tm%DTT, tm%TOP, &
                         tm%TOP%XCOVER, tm%TOP%LCOVER, zdef_road_dir,                   &
                      pz0_town=tm%T%CUR%XZ0_TOWN, palb_roof=tm%T%CUR%XALB_ROOF,         &
                      pemis_roof=tm%T%CUR%XEMIS_ROOF,phc_roof=tm%T%CUR%XHC_ROOF,ptc_roof=tm%T%CUR%XTC_ROOF, &
                      pd_roof=tm%T%CUR%XD_ROOF, palb_road=tm%T%CUR%XALB_ROAD,                                &
                      pemis_road=tm%T%CUR%XEMIS_ROAD,phc_road=tm%T%CUR%XHC_ROAD,ptc_road=tm%T%CUR%XTC_ROAD, &
                      pd_road=tm%T%CUR%XD_ROAD, palb_wall=tm%T%CUR%XALB_WALL,                                &
                      pemis_wall=tm%T%CUR%XEMIS_WALL,phc_wall=tm%T%CUR%XHC_WALL,ptc_wall=tm%T%CUR%XTC_WALL, &
                      pd_wall=tm%T%CUR%XD_WALL, pbld_height=tm%T%CUR%XBLD_HEIGHT,                        &
                      pwall_o_hor=tm%T%CUR%XWALL_O_HOR,pbld=tm%T%CUR%XBLD, proad_dir=tm%T%CUR%XROAD_DIR,    &
                      pgarden=tm%T%CUR%XGARDEN,                                           &
                      ph_traffic=tm%T%CUR%XH_TRAFFIC, ple_traffic=tm%T%CUR%XLE_TRAFFIC,            &
                      ph_industry=tm%T%CUR%XH_INDUSTRY, ple_industry=tm%T%CUR%XLE_INDUSTRY,        &
                      prough_roof = tm%T%CUR%XROUGH_ROOF, prough_wall = tm%T%CUR%XROUGH_WALL,      &
                      presidential = tm%T%CUR%XRESIDENTIAL,                               &
                      pgreenroof = tm%T%CUR%XGREENROOF,                                   &
                      pemis_panel=tm%TPN%XEMIS_PANEL, palb_panel=tm%TPN%XALB_PANEL,            &
                      peff_panel=tm%TPN%XEFF_PANEL, pfrac_panel=tm%TPN%XFRAC_PANEL             )
  !
  IF (.NOT. tm%TOP%LGREENROOF .AND. maxval(tm%T%CUR%XGREENROOF)>0. ) THEN 
    WRITE(iluout,*) 'You choose NOT to have greenroofs, BUT your greenroof fraction is not zero'
    WRITE(iluout,*) 'Please activate the greenroof option (and rerun the SURFEX suite from the PGD step)'
    WRITE(iluout,*) 'Or be sure NOT to have any greenroofs in your area'
    CALL abor1_sfx('INIT_TEBN: GREENROOF OPTION NOT ACTIVATED WHILE GREENROOFS ARE PRESENT')
  ENDIF
  !
  IF (.NOT. tm%TOP%LSOLAR_PANEL .AND. maxval(tm%TPN%XFRAC_PANEL)>0. ) THEN 
    WRITE(iluout,*) 'You choose NOT to have solar panels, BUT your solar panel fraction is not zero'
    WRITE(iluout,*) 'Please activate the solar panel option (and rerun the SURFEX suite from the PGD step)'
    WRITE(iluout,*) 'Or be sure NOT to have any solar panel in your area'
    CALL abor1_sfx('INIT_TEBN: SOLAR_PANEL OPTION NOT ACTIVATED WHILE SOLAR PANELS ARE PRESENT')
  ENDIF
  !
  !-------------------------------------------------------------------------------
  !
  !*       5.     Sky-view-factors:
  !               ----------------
  !
  ALLOCATE(tm%T%CUR%XSVF_ROAD  (ilu))
  ALLOCATE(tm%T%CUR%XSVF_GARDEN(ilu))
  ALLOCATE(tm%T%CUR%XSVF_WALL  (ilu))
  !
  ALLOCATE(tm%B%CUR%XGR          (ilu))
  ALLOCATE(tm%B%CUR%XALB_WIN     (ilu))
  ALLOCATE(tm%B%CUR%XF_WASTE_CAN (ilu))
  !
  !
  CALL teb_morpho(hprogram, tm%T%CUR%XBLD, tm%T%CUR%XWALL_O_HOR, tm%T%CUR%XGARDEN, tm%T%CUR%XBLD_HEIGHT, &
                  tm%T%CUR%XROAD, tm%T%CUR%XROAD_O_GRND, tm%T%CUR%XGARDEN_O_GRND, tm%T%CUR%XWALL_O_GRND, &
                  tm%T%CUR%XCAN_HW_RATIO, tm%T%CUR%XSVF_ROAD, tm%T%CUR%XSVF_GARDEN, tm%T%CUR%XSVF_WALL, &
                  tm%T%CUR%XZ0_TOWN, tm%T%CUR%XWALL_O_BLD, tm%T%CUR%XH_TRAFFIC, tm%T%CUR%XLE_TRAFFIC      )
                !
  !-------------------------------------------------------------------------------
  !
  !*       6.     Building Energy Model
  !               ---------------------
  !
  CALL init_bem_n(dgu, dtco, ug, u, tm, &
                  iluout)
  !
  !-------------------------------------------------------------------------------
  !
  !*      7.      Case of urban green areas
  !               -------------------------
  !
  IF (tm%TOP%LGARDEN) THEN
  !
    CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')     
    IF (jpatch==1) CALL init_teb_veg_options_n(&
                                               tm%CHT, tm%DGMTO, gdm%TGDO, gdm%TVG, &
                                               hprogram)
    CALL init_teb_garden_pgd_n(dtco, u, chi, dti, i, dst, slt, tm%CHT, tm%TG, tm%T, tm%TOP, gdm, &
                               hprogram,hinit,(jpatch==1),ki,ksv,hsv,iversion,ibugfix,pco2,prhoa)
    ! Case of urban green roofs
    IF (tm%TOP%LGREENROOF) CALL init_teb_greenroof_pgd_n(dtco, u, chi, dti, i, dst, slt, &
                                       tm%CHT, tm%TG, tm%T, tm%TOP, gdm%TVG, grm, &
                                        hprogram,hinit,(jpatch==1),ki,ksv,hsv,iversion,pco2,prhoa)
    CALL end_io_surf_n(hprogram)
    !
  ENDIF
!-------------------------------------------------------------------------------
END DO ! end of loop on TEB patches
!-------------------------------------------------------------------------------
!
!* Read irrigation parameters for TEB
!
 CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')     
 CALL read_pgd_teb_irrig_n(&
                           tm%TG, gdm%TIR, &
                           hprogram)
 CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
!* if only physiographic fields are to be initialized, stop here.
!
IF (hinit/='ALL' .AND. hinit/='SOD') THEN
  IF (lhook) CALL dr_hook('INIT_TEB_N',1,zhook_handle)
  RETURN
END IF
!
!-------------------------------------------------------------------------------
!
!         Initialisation for IO
!
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
 CALL init_io_surf_n(dtco, dgu, u, &
                        hprogram,'TOWN  ','TEB   ','READ ')
!
!*       9.     Prognostic fields:
!               -----------------
!
!               -------------------------
!

!
!*              LOOP ON TEB PATCHES
!               -------------------
!
DO jpatch=1,tm%TOP%NTEB_PATCH
  CALL goto_wrapper_teb_patch(tm%B, tm%DGCT, tm%DGMT, tm%T, &
                        gdm%TGD, gdm%TGDPE, grm%TGR, grm%TGRPE, jpatch)
!
!* TEB fields
  CALL read_teb_n(tm%B, tm%BOP, dtco, dgu, u, tm%T, tm%TOP, tm%TPN, &
                  hprogram,jpatch)
!
  ALLOCATE(tm%T%CUR%XAC_ROOF    (ilu))
  ALLOCATE(tm%T%CUR%XAC_ROAD    (ilu))
  ALLOCATE(tm%T%CUR%XAC_WALL    (ilu))
  ALLOCATE(tm%T%CUR%XAC_TOP     (ilu))
  ALLOCATE(tm%T%CUR%XAC_ROOF_WAT(ilu))
  ALLOCATE(tm%T%CUR%XAC_ROAD_WAT(ilu))
  ALLOCATE(tm%T%CUR%XQSAT_ROOF  (ilu))
  ALLOCATE(tm%T%CUR%XQSAT_ROAD  (ilu))
  ALLOCATE(tm%T%CUR%XDELT_ROOF  (ilu))
  ALLOCATE(tm%T%CUR%XDELT_ROAD  (ilu))
!
!* Case of urban green areas
  IF (tm%TOP%LGARDEN) THEN
!    CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! change input file name to pgd name
!    CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')       
    CALL init_teb_garden_n(dtco, dgu, ug, u, tm%DGMTO, tm%TOP, gdm, &
                           hprogram,hinit,ki,ksw,psw_bands,jpatch)
  ! Case of urban green roofs
    IF (tm%TOP%LGREENROOF) CALL init_teb_greenroof_n(dtco, u, tm%DGMTO, tm%TOP, gdm%TVG, grm, &
                                                  hprogram,hinit,ki,ksv,psw_bands,jpatch)
!    CALL END_IO_SURF_n(HPROGRAM)
  ENDIF
!-------------------------------------------------------------------------------
!
!*      10.     Infra-red Radiative fields:
!               --------------------------
!
!* snow long-wave properties (not initialized in read_gr_snow)
!
  CALL init_snow_lw(xemissn,tm%T%CUR%TSNOW_ROOF)
  CALL init_snow_lw(xemissn,tm%T%CUR%TSNOW_ROAD)
!
  IF (tm%TOP%LGARDEN) THEN
    zdir_sw=0. ! night as first guess for albedo computation
    zsca_sw=0. !
    CALL garden_properties(tm%T, gdm, &
                           zdir_sw, zsca_sw, psw_bands, ksw,     &
                           zts_garden, zemis_garden, zalb_garden )      
  ELSE
    zalb_garden = xundef
    zemis_garden= xundef
    zts_garden  = xundef
  END IF
  !
  IF (tm%TOP%LGREENROOF) THEN
    zdir_sw=0. ! night as first guess for albedo computation
    zsca_sw=0. !
    CALL greenroof_properties(tm%T, gdm%TVG, grm, & 
                              zdir_sw, zsca_sw, psw_bands, ksw,              &
                              zts_greenroof, zemis_greenroof, zalb_greenroof )  
  ELSE
    zalb_greenroof  = xundef
    zemis_greenroof = xundef
    zts_greenroof   = xundef
  END IF
!
!* averaged albedo, emissivity and radiative temperature
!
  CALL averaged_tsrad_teb(tm%T%CUR%XEMIS_ROOF,tm%T%CUR%XT_ROOF(:,1),       &
                        tm%T%CUR%XEMIS_ROAD,tm%T%CUR%XT_ROAD(:,1),       &
                        tm%T%CUR%XEMIS_WALL,                    &
                        tm%T%CUR%XT_WALL_A(:,1),                &
                        tm%T%CUR%XT_WALL_B(:,1),                &
                        zemis_garden, zts_garden,      &
                        zemis_greenroof, zts_greenroof,&
                        tm%T%CUR%TSNOW_ROOF,tm%T%CUR%TSNOW_ROAD,         &
                        tm%T%CUR%XROAD, tm%T%CUR%XGREENROOF, tm%T%CUR%XGARDEN,    &
                        tm%T%CUR%XBLD,tm%T%CUR%XWALL_O_HOR,              &
                        tm%T%CUR%XSVF_ROAD,tm%T%CUR%XSVF_WALL,           &
                        tm%T%CUR%XSVF_GARDEN,                   &
                        pemis,ptsrad, tm%B%CUR%XT_WIN1,         &
                        tm%B%CUR%XGR                            )
!
!
!*       9.     Visible and near-infra-red Radiative fields:
!               -------------------------------------------
!
  ALLOCATE(zdir_alb(ilu))
  ALLOCATE(zsca_alb(ilu))
!
  CALL averaged_albedo_teb(tm%TOP%CBEM,tm%TOP%CROAD_DIR,tm%TOP%CWALL_OPT,pzenith,pazim, &
                       tm%T%CUR%XBLD, tm%T%CUR%XGARDEN, tm%T%CUR%XROAD_DIR, tm%T%CUR%XROAD, &
                       tm%T%CUR%XGREENROOF, tm%TPN%XFRAC_PANEL, tm%TPN%XALB_PANEL,       &
                       tm%T%CUR%XWALL_O_HOR, tm%T%CUR%XCAN_HW_RATIO,                 &
                       tm%T%CUR%XALB_ROOF, tm%T%CUR%XALB_ROAD, tm%T%CUR%XSVF_ROAD,   &
                       tm%T%CUR%XALB_WALL, tm%T%CUR%XSVF_WALL,                       &
                       zalb_garden, tm%T%CUR%XSVF_GARDEN, zalb_greenroof,            &
                       tm%T%CUR%TSNOW_ROOF, tm%T%CUR%TSNOW_ROAD,                     &
                       tm%B%CUR%XGR, tm%B%CUR%XSHGC, tm%B%CUR%XSHGC_SH, &
                       tm%B%CUR%XABS_WIN, tm%B%CUR%XALB_WIN,   &
                       tm%B%CUR%LSHAD_DAY,                                  &
                       zdir_alb, zsca_alb, tm%B%CUR%XTRAN_WIN               )  

  iswb=SIZE(psw_bands)
  DO jswb=1,iswb
    pdir_alb(:,jswb) = zdir_alb(:)
    psca_alb(:,jswb) = zsca_alb(:)
  END DO
  !
  DEALLOCATE(zdir_alb)
  DEALLOCATE(zsca_alb)
!-------------------------------------------------------------------------------
!
!*      10.     Chemistry /dust
!               ---------------
!
  CALL init_chemical_n(iluout, ksv, hsv, tm%CHT%SVT,          &
                     tm%CHT%CCH_NAMES, tm%CHT%CAER_NAMES,     &
                     hdstnames=tm%CHT%CDSTNAMES, hsltnames=tm%CHT%CSLTNAMES        )
!
!* Initialization of dry deposition scheme (chemistry)
!
  IF (tm%CHT%SVT%NBEQ>0 .AND. tm%CHT%CCH_DRY_DEP=='WES89') THEN
    ALLOCATE(tm%CHT%XDEP(ilu,tm%CHT%SVT%NBEQ))
  ELSE
    ALLOCATE(tm%CHT%XDEP(0,0))
  END IF
!
!-------------------------------------------------------------------------------
END DO ! end of loop on patches
!
IF (hinit/='ALL') THEN
  CALL end_io_surf_n(hprogram)
  IF (lhook) CALL dr_hook('INIT_TEB_N',1,zhook_handle)
  RETURN
END IF
!-------------------------------------------------------------------------------
!
!*       7.     Canopy air fields:
!               ------------------
!
 CALL read_teb_canopy_n(dtco, u, tm%TCP, tm%TOP, &
                        hprogram)
!
!-------------------------------------------------------------------------------
!
!*      11.     Diagnostics:
!               -----------
!
 CALL diag_teb_init_n(tm%DGT, tm%DGUT, &
                      hprogram,ilu,iswb)
DO jpatch=1,tm%TOP%NTEB_PATCH
  CALL goto_wrapper_teb_patch(tm%B, tm%DGCT, tm%DGMT, tm%T, &
                        gdm%TGD, gdm%TGDPE, grm%TGR, grm%TGRPE, jpatch)
  CALL diag_misc_teb_init_n(tm%DGCT, tm%DGMT, tm%DGMTO, tm%TOP, &
                            hprogram,ilu,iswb)
END DO ! end of loop on patches
!
!-------------------------------------------------------------------------------
!
!         End of IO
!
 CALL end_io_surf_n(hprogram)
IF (lhook) CALL dr_hook('INIT_TEB_N',1,zhook_handle)
!
!
END SUBROUTINE init_teb_n