Juan 13/01/2014: add header SURFEX_LIC to all SURFEX files
[MNH-git_open_source-lfs.git] / src / SURFEX / init_tebn.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #############################################################
6       SUBROUTINE INIT_TEB_n     (HPROGRAM,HINIT,                            &
7                                  KI,KSV,KSW,                                &
8                                  HSV,PCO2,PRHOA,                            &
9                                  PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
10                                  PEMIS,PTSRAD,                              &
11                                  KYEAR, KMONTH,KDAY, PTIME,                 &
12                                  HATMFILE,HATMFILETYPE,                     &
13                                  HTEST                                      )  
14 !     #############################################################
15 !
16 !!****  *INIT_TEB_n* - routine to initialize TEB
17 !!
18 !!    PURPOSE
19 !!    -------
20 !!
21 !!**  METHOD
22 !!    ------
23 !!
24 !!    EXTERNAL
25 !!    --------
26 !!
27 !!
28 !!    IMPLICIT ARGUMENTS
29 !!    ------------------
30 !!
31 !!    REFERENCE
32 !!    ---------
33 !!
34 !!
35 !!    AUTHOR
36 !!    ------
37 !!      V. Masson   *Meteo France*      
38 !!
39 !!    MODIFICATIONS
40 !!    -------------
41 !!      Original    01/2003
42 !!      G. Pigeon   09/2012: add ROUGH_WALL/ROUGH_ROOF/CH_BEM for conv. coef.
43 !-------------------------------------------------------------------------------
44 !
45 !*       0.    DECLARATIONS
46 !              ------------
47 !
48 USE MODD_IO_SURF_ASC,ONLY: CMASK
49 USE MODD_SNOW_PAR, ONLY : XEMISSN
50 !
51 USE MODD_READ_NAMELIST, ONLY : LNAM_READ
52
53 USE MODD_TEB_n,           ONLY: LGARDEN, LGREENROOF,                                     &
54                                 XTSTEP, XOUT_TSTEP, TTIME, XCOVER,                       &
55                                 XH_TRAFFIC, XLE_TRAFFIC, XH_INDUSTRY, XLE_INDUSTRY,      &
56                                 XZ0_TOWN, XBLD, XGARDEN, XROAD_DIR, XGREENROOF,          &
57                                 XROAD, XBLD_HEIGHT, XWALL_O_HOR, XCAN_HW_RATIO,          &
58                                 XROAD_O_GRND, XGARDEN_O_GRND, XWALL_O_GRND, XWALL_O_BLD, &
59                                 XALB_ROOF, XEMIS_ROOF, XHC_ROOF,XTC_ROOF, XD_ROOF,       &
60                                 XALB_ROAD, XEMIS_ROAD, XHC_ROAD,XTC_ROAD, XD_ROAD,       &
61                                 XALB_WALL, XEMIS_WALL, XHC_WALL,XTC_WALL, XD_WALL,       &
62                                 XSVF_ROAD, XSVF_GARDEN, XSVF_WALL,                       &
63                                 TSNOW_ROOF, TSNOW_ROAD,                                  &
64                                 NROOF_LAYER, NROAD_LAYER, NWALL_LAYER,                   &
65                                 XT_ROOF, XT_ROAD, XT_WALL_A, XT_WALL_B, CZ0H,            &
66                                 CROAD_DIR, CWALL_OPT,                                    &
67                                 XT_CANYON, XQ_CANYON,                                    &
68                                 XAC_ROOF, XAC_ROAD, XAC_WALL, XAC_TOP,                   &
69                                 XAC_ROOF_WAT, XAC_ROAD_WAT,                              &
70                                 XQSAT_ROOF, XQSAT_ROAD, XDELT_ROOF, XDELT_ROAD,          &
71                                 NTEB_PATCH, XTEB_PATCH, CBEM, CCH_BEM,                   &
72                                 XROUGH_ROOF, XROUGH_WALL
73
74 USE MODD_BEM_n,           ONLY: NFLOOR_LAYER, XHC_FLOOR, XTC_FLOOR, XD_FLOOR,            &
75                                 XTCOOL_TARGET, XTHEAT_TARGET, XF_WASTE_CAN, XEFF_HEAT,   &
76                                 XQIN, XQIN_FRAD, XSHGC, XSHGC_SH, XU_WIN, XGR,           &
77                                 XFLOOR_HEIGHT, XINF, XQIN_FLAT, XHR_TARGET, XV_VENT,     &
78                                 XCAP_SYS_HEAT, XAUX_MAX, XCAP_SYS_RAT, XT_ADP,           &
79                                 XM_SYS_RAT, XCOP_RAT, XT_SIZE_MAX, XT_SIZE_MIN,          &
80                                 CCOOL_COIL, CHEAT_COIL, XF_WATER_COND, LSHAD_DAY,        &
81                                 LNATVENT_NIGHT, LSHADE, XSHADE, CNATVENT, XNATVENT,      &
82                                 LAUTOSIZE, XT_WIN1, XALB_WIN, XABS_WIN, XUGG_WIN,        &
83                                 XN_FLOOR, XGLAZ_O_BLD, XMASS_O_BLD, XFLOOR_HW_RATIO,     &
84                                 XF_FLOOR_MASS, XF_FLOOR_WALL, XF_FLOOR_WIN,              &
85                                 XF_FLOOR_ROOF, XF_WALL_FLOOR, XF_WALL_MASS,              &
86                                 XF_WALL_WIN, XF_WIN_FLOOR, XF_WIN_MASS, XF_WIN_WALL,     &
87                                 XF_MASS_FLOOR, XF_MASS_WALL, XF_MASS_WIN, XTRAN_WIN
88
89 USE MODD_TEB_VEG_n,       ONLY: CC1DRY, CSOILFRZ, CDIFSFCOND, CSNOWRES,                  &
90                                 CCPSURF, XCGMAX, CKSAT, CTOPREG,                         &
91                                 CRAIN, CHORT,                                            &
92                                 LCANOPY_DRAG, LVEGUPD
93
94 USE MODD_CH_TEB_n,        ONLY: XDEP, CCH_DRY_DEP, CSV, CCH_NAMES,                       &
95                                 NBEQ, NSV_CHSBEG, NSV_CHSEND,                            &
96                                 NAEREQ, NSV_AERBEG, NSV_AEREND, CAER_NAMES,              &
97                                 NSV_DSTBEG, NSV_DSTEND, NDSTEQ, CDSTNAMES,               &
98                                 NSV_SLTBEG, NSV_SLTEND, NSLTEQ, CSLTNAMES  
99
100
101 USE MODD_CHS_AEROSOL,     ONLY: LVARSIGI, LVARSIGJ
102 USE MODD_DST_SURF,        ONLY: LVARSIG_DST, NDSTMDE, NDST_MDEBEG, LRGFIX_DST 
103 USE MODD_SLT_SURF,        ONLY: LVARSIG_SLT, NSLTMDE, NSLT_MDEBEG, LRGFIX_SLT
104 USE MODD_DIAG_TEB_n,      ONLY: N2M, LSURF_BUDGET, LRAD_BUDGET, XDIAG_TSTEP,             &
105                                   LPGD, LPGD_FIX, L2M_MIN_ZS, LCOEF, LSURF_VARS  
106 USE MODD_DIAG_MISC_TEB_n, ONLY: LSURF_MISC_BUDGET,                                       &
107                                   LSURF_DIAG_ALBEDO, LSURF_EVAP_BUDGET  
108 USE MODD_DIAG_UTCI_TEB_n, ONLY: LUTCI
109 USE MODD_SURF_PAR,        ONLY: XUNDEF, NUNDEF
110 !
111 USE MODD_TEB_GARDEN_n,    ONLY : XLAI_GARDEN => XLAI
112 USE MODD_TEB_GREENROOF_n, ONLY : XLAI_GREENROOF => XLAI, NLAYER_GR
113 !
114 USE MODI_INIT_IO_SURF_n
115 USE MODI_DEFAULT_CH_DEP
116 USE MODI_DEFAULT_TEB
117 USE MODI_DEFAULT_DIAG_TEB
118 USE MODI_READ_DEFAULT_TEB_n
119 USE MODI_READ_TEB_CONF_n
120 USE MODI_PREP_CTRL_TEB
121 USE MODI_READ_TEB_n
122 USE MODI_READ_PGD_TEB_n
123 USE MODI_CONVERT_TEB
124 USE MODI_CONVERT_PATCH_TEB
125 USE MODI_INIT_SNOW_LW
126 USE MODI_AVERAGED_TSRAD_TEB
127 USE MODI_AVERAGED_ALBEDO_TEB
128 USE MODI_DIAG_TEB_INIT_n
129 USE MODI_DIAG_MISC_TEB_INIT_n
130 USE MODI_END_IO_SURF_n
131 USE MODI_GET_LUOUT
132 USE MODI_READ_SURF
133 USE MODI_READ_PREP_TEB_SNOW
134 USE MODI_READ_TEB_DATE
135 USE MODI_READ_NAM_PREP_TEB_n
136 USE MODI_INIT_CHEMICAL_n
137 USE MODI_GARDEN_PROPERTIES
138 USE MODI_HVAC_AUTOSIZE
139 USE MODI_GOTO_TEB
140 !
141 USE MODI_INIT_TEB_GARDEN_n
142 USE MODI_INIT_TEB_GARDEN_PGD_n
143 USE MODI_INIT_TEB_VEG_OPTIONS_n
144 USE MODI_TEB_MORPHO
145 USE MODI_INIT_BEM_n
146 USE MODI_INIT_TEB_GREENROOF_n
147 USE MODI_INIT_TEB_GREENROOF_PGD_n
148 USE MODI_GREENROOF_PROPERTIES
149 !
150 USE MODI_READ_COVER_GARDEN
151 USE MODI_WRITE_COVER_TEX_TEB
152 USE MODI_ABOR1_SFX
153 USE MODI_READ_TEB_CANOPY_n
154 USE MODI_SET_SURFEX_FILEIN
155 !
156 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
157 USE PARKIND1  ,ONLY : JPRB
158 !
159 IMPLICIT NONE
160 !
161 !*       0.1   Declarations of arguments
162 !              -------------------------
163 !
164  CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM    ! program calling surf. schemes
165  CHARACTER(LEN=3),                   INTENT(IN)  :: HINIT       ! choice of fields to initialize
166 INTEGER,                            INTENT(IN)  :: KI          ! number of points
167 INTEGER,                            INTENT(IN)  :: KSV         ! number of scalars
168 INTEGER,                            INTENT(IN)  :: KSW         ! number of short-wave spectral bands
169  CHARACTER(LEN=6), DIMENSION(KSV),   INTENT(IN)  :: HSV         ! name of all scalar variables
170 REAL,             DIMENSION(KI),    INTENT(IN)  :: PCO2        ! CO2 concentration (kg/m3)
171 REAL,             DIMENSION(KI),    INTENT(IN)  :: PRHOA       ! air density
172 REAL,             DIMENSION(KI),    INTENT(IN)  :: PZENITH     ! solar zenithal angle
173 REAL,             DIMENSION(KI),    INTENT(IN)  :: PAZIM       ! solar azimuthal angle (rad from N, clock)
174 REAL,             DIMENSION(KSW),   INTENT(IN)  :: PSW_BANDS   ! middle wavelength of each band
175 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB    ! direct albedo for each band
176 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB    ! diffuse albedo for each band
177 REAL,             DIMENSION(KI),    INTENT(OUT) :: PEMIS       ! emissivity
178 REAL,             DIMENSION(KI),    INTENT(OUT) :: PTSRAD      ! radiative temperature
179 INTEGER,                            INTENT(IN)  :: KYEAR       ! current year (UTC)
180 INTEGER,                            INTENT(IN)  :: KMONTH      ! current month (UTC)
181 INTEGER,                            INTENT(IN)  :: KDAY        ! current day (UTC)
182 REAL,                               INTENT(IN)  :: PTIME       ! current time since
183                                                                !  midnight (UTC, s)
184 !
185  CHARACTER(LEN=28),                  INTENT(IN)  :: HATMFILE    ! atmospheric file name
186  CHARACTER(LEN=6),                   INTENT(IN)  :: HATMFILETYPE! atmospheric file type
187  CHARACTER(LEN=2),                   INTENT(IN)  :: HTEST       ! must be equal to 'OK'
188 !
189 !*       0.2   Declarations of local variables
190 !              -------------------------------
191 !
192 INTEGER                         :: ILU              ! sizes of TEB arrays
193 INTEGER                         :: ILUOUT           ! unit of output listing file
194 INTEGER                         :: IRESP            ! return code
195 !
196 INTEGER                         :: ISWB             ! number of shortwave spectral bands
197 INTEGER                         :: JSWB             ! loop on shortwave spectral bands
198 !
199 REAL                            :: ZDEF_ROAD_DIR    ! default raod direction
200 REAL, DIMENSION(:), ALLOCATABLE :: ZDIR_ALB         ! direct town albedo
201 REAL, DIMENSION(:), ALLOCATABLE :: ZSCA_ALB         ! diffuse town albedo
202 !
203 !              local variables for urban green areas
204 REAL, DIMENSION(KI,KSW)         :: ZDIR_SW          ! direct  SW for each band
205 REAL, DIMENSION(KI,KSW)         :: ZSCA_SW          ! diffuse SW for each band
206 REAL, DIMENSION(KI)             :: ZEMIS_GARDEN     ! emissivity
207 REAL, DIMENSION(KI)             :: ZALB_GARDEN      ! albedo
208 REAL, DIMENSION(KI)             :: ZTS_GARDEN       ! radiative temperature
209 !
210 !              local variables for urban greenroofs
211 REAL, DIMENSION(KI)             :: ZEMIS_GREENROOF     ! emissivity
212 REAL, DIMENSION(KI)             :: ZALB_GREENROOF      ! albedo
213 REAL, DIMENSION(KI)             :: ZTS_GREENROOF       ! radiative temperature
214 !
215 INTEGER                         :: JPATCH
216 INTEGER                         :: IVERSION, IBUGFIX
217
218 REAL(KIND=JPRB) :: ZHOOK_HANDLE
219 !-------------------------------------------------------------------------------
220 !
221 !         Initialisation for IO
222 !
223 IF (LHOOK) CALL DR_HOOK('INIT_TEB_N',0,ZHOOK_HANDLE)
224  CALL GET_LUOUT(HPROGRAM,ILUOUT)
225 !
226 IF (HTEST/='OK') THEN
227   CALL ABOR1_SFX('INIT_TEBN: FATAL ERROR DURING ARGUMENT TRANSFER')
228 END IF
229 !
230 !         Other little things
231 !
232 PDIR_ALB = XUNDEF
233 PSCA_ALB = XUNDEF
234 PEMIS    = XUNDEF
235 PTSRAD   = XUNDEF
236 !
237 LSURF_DIAG_ALBEDO = .FALSE.
238 LSURF_EVAP_BUDGET = .FALSE.
239 !
240 IF (LNAM_READ) THEN
241  !
242  !*       0.     Defaults
243  !               --------
244  !
245  !        0.1. Hard defaults
246  !      
247  CALL DEFAULT_TEB(CZ0H,XTSTEP,XOUT_TSTEP, CCH_BEM)
248  CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
249  CALL DEFAULT_DIAG_TEB(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS, &
250                        LSURF_MISC_BUDGET,LUTCI,LPGD,LPGD_FIX,XDIAG_TSTEP)  
251 !
252 ENDIF
253 !
254 !        0.2. Defaults from file header
255 !    
256  CALL READ_DEFAULT_TEB_n(HPROGRAM)
257 !
258 !*       1.     Reading of configuration:
259 !               -------------------------
260 !
261  CALL READ_TEB_CONF_n(HPROGRAM)
262 !
263 !* initialization of snow scheme
264 !
265 IF (HINIT=='PRE') THEN
266   DO JPATCH=1,NTEB_PATCH
267     CALL GOTO_TEB(JPATCH)
268     CALL READ_PREP_TEB_SNOW(HPROGRAM,TSNOW_ROOF%SCHEME,TSNOW_ROOF%NLAYER, &
269                                      TSNOW_ROAD%SCHEME,TSNOW_ROAD%NLAYER)
270   END DO
271 ENDIF
272 !
273 !*       2.     Cover fields and grid:
274 !               ---------------------
275 !* date
276 !
277 SELECT CASE (HINIT)
278   CASE ('PGD')
279     TTIME%TDATE%YEAR = NUNDEF
280     TTIME%TDATE%MONTH= NUNDEF
281     TTIME%TDATE%DAY  = NUNDEF
282     TTIME%TIME       = XUNDEF
283
284   CASE ('PRE')
285     CALL PREP_CTRL_TEB(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
286                          LSURF_EVAP_BUDGET,LSURF_MISC_BUDGET,LUTCI,ILUOUT )           
287     IF (LNAM_READ) CALL READ_NAM_PREP_TEB_n(HPROGRAM)   
288     CALL READ_TEB_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,TTIME)
289
290   CASE DEFAULT
291     CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
292     CALL READ_SURF(HPROGRAM,'DTCUR',TTIME,IRESP)
293     CALL END_IO_SURF_n(HPROGRAM)
294 END SELECT
295 !
296 !-----------------------------------------------------------------------------------------------------
297 ! READ PGD FILE
298 !-----------------------------------------------------------------------------------------------------
299 !
300 !         Initialisation for IO
301 !
302  CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
303  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
304 !
305  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
306  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
307 !
308 !         Reading of the fields
309 !
310  CALL READ_COVER_GARDEN(HPROGRAM,LGARDEN)
311 !
312  CALL READ_PGD_TEB_n(HPROGRAM)
313 !
314  CALL END_IO_SURF_n(HPROGRAM)
315
316 !*        Fraction of each patch in the grid mesh
317 !
318 ILU = SIZE(XCOVER,1)
319 !
320 ALLOCATE(XTEB_PATCH(ILU,NTEB_PATCH))
321  CALL CONVERT_TEB(XCOVER,XTEB_PATCH)
322 !
323  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
324  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
325 !
326  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
327  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
328 !
329 !* reads what is the option defined for road orientations & walls
330 !
331 IF (HINIT=='ALL') THEN
332   CROAD_DIR='UNIF'
333   CWALL_OPT='UNIF'
334   IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
335     CALL READ_SURF(HPROGRAM,'ROAD_DIR',CROAD_DIR,IRESP)
336     CALL READ_SURF(HPROGRAM,'WALL_OPT',CWALL_OPT,IRESP)
337   END IF
338 END IF
339  CALL END_IO_SURF_n(HPROGRAM)
340 !-----------------------------------------------------------------------------------
341 !
342 !*              LOOP ON TEB PATCHES
343 !               -------------------
344 !
345 DO JPATCH=1,NTEB_PATCH
346
347   CALL GOTO_TEB(JPATCH)
348   !-----------------------------------------------------------------------------------
349   !
350   !*       3.     Physiographic data fields from land cover:
351   !               -----------------------------------------
352   !
353   ALLOCATE(XZ0_TOWN     (ILU))
354   ALLOCATE(XALB_ROOF    (ILU))
355   ALLOCATE(XEMIS_ROOF   (ILU))
356   ALLOCATE(XALB_ROAD    (ILU))
357   ALLOCATE(XEMIS_ROAD   (ILU))
358   ALLOCATE(XALB_WALL    (ILU))
359   ALLOCATE(XEMIS_WALL   (ILU))
360   ALLOCATE(XBLD         (ILU))
361   ALLOCATE(XROAD_DIR    (ILU))
362   ALLOCATE(XROAD        (ILU))
363   ALLOCATE(XBLD_HEIGHT  (ILU))
364   ALLOCATE(XWALL_O_HOR  (ILU))
365   ALLOCATE(XCAN_HW_RATIO(ILU))
366   ALLOCATE(XROAD_O_GRND(ILU))
367   ALLOCATE(XGARDEN_O_GRND(ILU))
368   ALLOCATE(XWALL_O_GRND(ILU))
369   ALLOCATE(XWALL_O_BLD(ILU))
370   ALLOCATE(XH_TRAFFIC   (ILU))
371   ALLOCATE(XLE_TRAFFIC  (ILU))
372   ALLOCATE(XH_INDUSTRY  (ILU))
373   ALLOCATE(XLE_INDUSTRY (ILU))
374   ALLOCATE(XHC_ROOF     (ILU,NROOF_LAYER))
375   ALLOCATE(XTC_ROOF     (ILU,NROOF_LAYER))
376   ALLOCATE(XD_ROOF      (ILU,NROOF_LAYER))
377   ALLOCATE(XHC_ROAD     (ILU,NROAD_LAYER))
378   ALLOCATE(XTC_ROAD     (ILU,NROAD_LAYER))
379   ALLOCATE(XD_ROAD      (ILU,NROAD_LAYER))
380   ALLOCATE(XHC_WALL     (ILU,NWALL_LAYER))
381   ALLOCATE(XTC_WALL     (ILU,NWALL_LAYER))
382   ALLOCATE(XD_WALL      (ILU,NWALL_LAYER))
383   ALLOCATE(XROUGH_ROOF      (ILU))
384   ALLOCATE(XROUGH_WALL      (ILU))
385   ALLOCATE(XGREENROOF       (ILU))
386   ALLOCATE(XGARDEN          (ILU))
387   !
388   XROAD_DIR(:) = 0.
389   XROAD    (:) = 0.
390   !
391   ZDEF_ROAD_DIR = 0.
392   IF (CROAD_DIR/='UNIF') THEN
393     !* road direction if not specified by the user depends on patch number
394     !  First patch has a Notrh-South road. Other patches have roads spaced by
395     !  regular angles
396     ZDEF_ROAD_DIR = 180. * FLOAT(JPATCH-1) / FLOAT(NTEB_PATCH)
397   END IF
398   !
399   CALL CONVERT_PATCH_TEB(XCOVER, ZDEF_ROAD_DIR,                                  &
400                       PZ0_TOWN=XZ0_TOWN,                                         &
401                       PALB_ROOF=XALB_ROOF,                                       &
402                       PEMIS_ROOF=XEMIS_ROOF,PHC_ROOF=XHC_ROOF,PTC_ROOF=XTC_ROOF, &
403                       PD_ROOF=XD_ROOF,                                           &
404                       PALB_ROAD=XALB_ROAD,                                       &
405                       PEMIS_ROAD=XEMIS_ROAD,PHC_ROAD=XHC_ROAD,PTC_ROAD=XTC_ROAD, &
406                       PD_ROAD=XD_ROAD,                                           &
407                       PALB_WALL=XALB_WALL,                                       &
408                       PEMIS_WALL=XEMIS_WALL,PHC_WALL=XHC_WALL,PTC_WALL=XTC_WALL, &
409                       PD_WALL=XD_WALL,                                           &
410                       PBLD_HEIGHT=XBLD_HEIGHT,                                   &
411                       PWALL_O_HOR=XWALL_O_HOR,PBLD=XBLD, PROAD_DIR=XROAD_DIR,    &
412                       PGARDEN=XGARDEN,                                           &
413                       PH_TRAFFIC=XH_TRAFFIC, PLE_TRAFFIC=XLE_TRAFFIC,            &
414                       PH_INDUSTRY=XH_INDUSTRY, PLE_INDUSTRY=XLE_INDUSTRY,        &
415                       PROUGH_ROOF = XROUGH_ROOF, PROUGH_WALL = XROUGH_WALL,      &
416                       PGREENROOF = XGREENROOF                                    )
417   !
418   IF (.NOT. LGREENROOF .AND. MAXVAL(XGREENROOF)>0. ) THEN !<== A paralleliser pour un stop propre
419     WRITE(ILUOUT,*) 'You choose NOT to have greenroofs, BUT your greenroof fraction is not zero'
420     WRITE(ILUOUT,*) 'Please activate the greenroof option (and rerun the SURFEX suite from the PGD step)'
421     WRITE(ILUOUT,*) 'Or be sure NOT to have any greenroofs in your area'
422     CALL ABOR1_SFX('INIT_TEBN: GREENROOF OPTION NOT ACTIVATED WHILE GREENROOFS ARE PRESENT')
423   ENDIF
424   !-------------------------------------------------------------------------------
425   !
426   !*       5.     Sky-view-factors:
427   !               ----------------
428   !
429   ALLOCATE(XSVF_ROAD  (ILU))
430   ALLOCATE(XSVF_GARDEN(ILU))
431   ALLOCATE(XSVF_WALL  (ILU))
432   !
433   ALLOCATE(XGR          (ILU))
434   ALLOCATE(XALB_WIN     (ILU))
435   ALLOCATE(XF_WASTE_CAN (ILU))
436   !
437   !
438   CALL TEB_MORPHO(HPROGRAM, XBLD, XWALL_O_HOR, XGARDEN, XBLD_HEIGHT, XROAD, XROAD_O_GRND, &
439                 XGARDEN_O_GRND, XWALL_O_GRND, XCAN_HW_RATIO, XSVF_ROAD, XSVF_GARDEN,    &
440                 XSVF_WALL, XZ0_TOWN, XWALL_O_BLD, XH_TRAFFIC, XLE_TRAFFIC               )
441                 !
442   !-------------------------------------------------------------------------------
443   !
444   !*       6.     Building Energy Model
445   !               ---------------------
446   !
447   CALL INIT_BEM_n(ILUOUT)
448   !
449   !-------------------------------------------------------------------------------
450   !
451   !*      7.      Case of urban green areas
452   !               -------------------------
453   !
454   IF (LGARDEN) THEN
455   !
456     CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
457     CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')     
458     IF (JPATCH==1) CALL INIT_TEB_VEG_OPTIONS_n(HPROGRAM)
459     CALL INIT_TEB_GARDEN_PGD_n(HPROGRAM,HINIT,(JPATCH==1),KI,KSV,HSV,IVERSION,IBUGFIX,PCO2,PRHOA)
460     ! Case of urban green roofs
461     IF (LGREENROOF) CALL INIT_TEB_GREENROOF_PGD_n(HPROGRAM,HINIT,(JPATCH==1), &
462                                                   KI,KSV,HSV,IVERSION,PCO2,PRHOA)
463     CALL END_IO_SURF_n(HPROGRAM)
464     !
465   ENDIF
466 !-------------------------------------------------------------------------------
467 END DO ! end of loop on TEB patches
468 !-------------------------------------------------------------------------------
469 !
470 !* if only physiographic fields are to be initialized, stop here.
471 !
472  CALL WRITE_COVER_TEX_TEB
473 !
474 IF (HINIT/='ALL') THEN
475   IF (LHOOK) CALL DR_HOOK('INIT_TEB_N',1,ZHOOK_HANDLE)
476   RETURN
477 END IF
478 !
479 !-------------------------------------------------------------------------------
480 !
481 !         Initialisation for IO
482 !
483  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
484  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
485 !
486 !*       9.     Prognostic fields:
487 !               -----------------
488 !
489 !               -------------------------
490 !
491
492 !
493 !*              LOOP ON TEB PATCHES
494 !               -------------------
495 !
496 DO JPATCH=1,NTEB_PATCH
497   CALL GOTO_TEB(JPATCH)
498 !
499 !* TEB fields
500   CALL READ_TEB_n(HPROGRAM,JPATCH)
501 !
502   ALLOCATE(XAC_ROOF    (ILU))
503   ALLOCATE(XAC_ROAD    (ILU))
504   ALLOCATE(XAC_WALL    (ILU))
505   ALLOCATE(XAC_TOP     (ILU))
506   ALLOCATE(XAC_ROOF_WAT(ILU))
507   ALLOCATE(XAC_ROAD_WAT(ILU))
508   ALLOCATE(XQSAT_ROOF  (ILU))
509   ALLOCATE(XQSAT_ROAD  (ILU))
510   ALLOCATE(XDELT_ROOF  (ILU))
511   ALLOCATE(XDELT_ROAD  (ILU))
512 !
513 !* Case of urban green areas
514   IF (LGARDEN) THEN
515 !    CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! change input file name to pgd name
516 !    CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')       
517     CALL INIT_TEB_GARDEN_n(HPROGRAM,HINIT,KI,KSW,PSW_BANDS)
518   ! Case of urban green roofs
519     IF (LGREENROOF) CALL INIT_TEB_GREENROOF_n(HPROGRAM,HINIT,KI,KSV,PSW_BANDS)
520 !    CALL END_IO_SURF_n(HPROGRAM)
521   ENDIF
522 !-------------------------------------------------------------------------------
523 !
524 !*      10.     Infra-red Radiative fields:
525 !               --------------------------
526 !
527 !* snow long-wave properties (not initialized in read_gr_snow)
528 !
529   CALL INIT_SNOW_LW(XEMISSN,TSNOW_ROOF)
530   CALL INIT_SNOW_LW(XEMISSN,TSNOW_ROAD)
531 !
532   IF (LGARDEN) THEN
533     ZDIR_SW=0. ! night as first guess for albedo computation
534     ZSCA_SW=0. !
535     CALL GARDEN_PROPERTIES(ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW,     &
536                            ZTS_GARDEN, ZEMIS_GARDEN, ZALB_GARDEN )      
537   ELSE
538     ZALB_GARDEN = XUNDEF
539     ZEMIS_GARDEN= XUNDEF
540     ZTS_GARDEN  = XUNDEF
541   END IF
542   !
543   IF (LGREENROOF) THEN
544     ZDIR_SW=0. ! night as first guess for albedo computation
545     ZSCA_SW=0. !
546     CALL GREENROOF_PROPERTIES(ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW,              &
547                               ZTS_GREENROOF, ZEMIS_GREENROOF, ZALB_GREENROOF )  
548   ELSE
549     ZALB_GREENROOF  = XUNDEF
550     ZEMIS_GREENROOF = XUNDEF
551     ZTS_GREENROOF   = XUNDEF
552   END IF
553 !
554 !* averaged albedo, emissivity and radiative temperature
555 !
556   CALL AVERAGED_TSRAD_TEB(XEMIS_ROOF,XT_ROOF(:,1),       &
557                         XEMIS_ROAD,XT_ROAD(:,1),       &
558                         XEMIS_WALL,                    &
559                         XT_WALL_A(:,1),                &
560                         XT_WALL_B(:,1),                &
561                         ZEMIS_GARDEN, ZTS_GARDEN,      &
562                         ZEMIS_GREENROOF, ZTS_GREENROOF,&
563                         TSNOW_ROOF,TSNOW_ROAD,         &
564                         XROAD, XGREENROOF, XGARDEN,    &
565                         XBLD,XWALL_O_HOR,              &
566                         XSVF_ROAD,XSVF_WALL,           &
567                         XSVF_GARDEN,                   &
568                         PEMIS,PTSRAD, XT_WIN1,         &
569                         XGR                            )
570 !
571 !
572 !*       9.     Visible and near-infra-red Radiative fields:
573 !               -------------------------------------------
574 !
575   ALLOCATE(ZDIR_ALB(ILU))
576   ALLOCATE(ZSCA_ALB(ILU))
577 !
578   CALL AVERAGED_ALBEDO_TEB(CBEM,CROAD_DIR,CWALL_OPT,PZENITH,PAZIM, &
579                        XBLD, XGARDEN, XROAD_DIR, XROAD, XGREENROOF,&
580                        XWALL_O_HOR, XCAN_HW_RATIO,                 &
581                        XALB_ROOF,                                  &
582                        XALB_ROAD, XSVF_ROAD,                       &
583                        XALB_WALL, XSVF_WALL,                       &
584                        ZALB_GARDEN, XSVF_GARDEN,                   &
585                        ZALB_GREENROOF,                             &
586                        TSNOW_ROOF, TSNOW_ROAD,                     &
587                        XGR, XSHGC, XSHGC_SH, XABS_WIN, XALB_WIN,   &
588                        LSHAD_DAY,                                  &
589                        ZDIR_ALB, ZSCA_ALB, XTRAN_WIN               )  
590
591   ISWB=SIZE(PSW_BANDS)
592   DO JSWB=1,ISWB
593     PDIR_ALB(:,JSWB) = ZDIR_ALB(:)
594     PSCA_ALB(:,JSWB) = ZSCA_ALB(:)
595   END DO
596   !
597   DEALLOCATE(ZDIR_ALB)
598   DEALLOCATE(ZSCA_ALB)
599 !-------------------------------------------------------------------------------
600 !
601 !*      10.     Chemistry /dust
602 !               ---------------
603 !
604   CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, NBEQ, CSV, NAEREQ,            &
605                      NSV_CHSBEG, NSV_CHSEND, NSV_AERBEG, NSV_AEREND, &
606                      CCH_NAMES, CAER_NAMES, NDSTEQ, NSV_DSTBEG,      &
607                      NSV_DSTEND, NSLTEQ, NSV_SLTBEG, NSV_SLTEND,     &
608                      HDSTNAMES=CDSTNAMES, HSLTNAMES=CSLTNAMES        )
609 !
610 !* Initialization of dry deposition scheme (chemistry)
611 !
612   IF (NBEQ>0 .AND. CCH_DRY_DEP=='WES89') THEN
613     ALLOCATE(XDEP(ILU,NBEQ))
614   ELSE
615     ALLOCATE(XDEP(0,0))
616   END IF
617 !
618 !-------------------------------------------------------------------------------
619 END DO ! end of loop on patches
620 !-------------------------------------------------------------------------------
621 !
622 !*       7.     Canopy air fields:
623 !               ------------------
624 !
625  CALL READ_TEB_CANOPY_n(HPROGRAM)
626 !
627 !-------------------------------------------------------------------------------
628 !
629 !*      11.     Diagnostics:
630 !               -----------
631 !
632  CALL DIAG_TEB_INIT_n(HPROGRAM,ILU,ISWB)
633 DO JPATCH=1,NTEB_PATCH
634   CALL GOTO_TEB(JPATCH)
635   CALL DIAG_MISC_TEB_INIT_n(HPROGRAM,ILU,ISWB)
636 END DO ! end of loop on patches
637 !
638 !-------------------------------------------------------------------------------
639 !
640 !         End of IO
641 !
642  CALL END_IO_SURF_n(HPROGRAM)
643 IF (LHOOK) CALL DR_HOOK('INIT_TEB_N',1,ZHOOK_HANDLE)
644 !
645 !
646 END SUBROUTINE INIT_TEB_n