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