source: palm/trunk/SOURCE/urban_surface_mod.f90 @ 3888

Last change on this file since 3888 was 3885, checked in by kanani, 6 years ago

restructure/add location/debug messages

  • Property svn:keywords set to Id
File size: 553.5 KB
Line 
1!> @file urban_surface_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2015-2019 Czech Technical University in Prague
18! Copyright 2015-2019 Institute of Computer Science of the
19!                     Czech Academy of Sciences, Prague
20! Copyright 1997-2019 Leibniz Universitaet Hannover
21!------------------------------------------------------------------------------!
22!
23! Current revisions:
24! ------------------
25!
26!
27! Former revisions:
28! -----------------
29! $Id: urban_surface_mod.f90 3885 2019-04-11 11:29:34Z hellstea $
30! Changes related to global restructuring of location messages and introduction
31! of additional debug messages
32!
33! 3882 2019-04-10 11:08:06Z suehring
34! Avoid different type kinds
35! Move definition of building-surface properties from declaration block
36! to an extra routine
37!
38! 3881 2019-04-10 09:31:22Z suehring
39! Revise determination of local ground-floor level height.
40! Make level 3 initalization conform with Palm-input-data standard
41! Move output of albedo and emissivity to radiation module
42!
43! 3832 2019-03-28 13:16:58Z raasch
44! instrumented with openmp directives
45!
46! 3824 2019-03-27 15:56:16Z pavelkrc
47! Remove unused imports
48!
49!
50! 3814 2019-03-26 08:40:31Z pavelkrc
51! unused subroutine commented out
52!
53! 3769 2019-02-28 10:16:49Z moh.hefny
54! removed unused variables
55!
56! 3767 2019-02-27 08:18:02Z raasch
57! unused variables removed from rrd-subroutines parameter list
58!
59! 3748 2019-02-18 10:38:31Z suehring
60! Revise conversion of waste-heat flux (do not divide by air density, will
61! be done in diffusion_s)
62!
63! 3745 2019-02-15 18:57:56Z suehring
64! - Remove internal flag indoor_model (is a global control parameter)
65! - add waste heat from buildings to the kinmatic heat flux
66! - consider waste heat in restart data
67! - remove unused USE statements
68!
69! 3744 2019-02-15 18:38:58Z suehring
70! fixed surface heat capacity in the building parameters
71! convert the file back to unix format
72!
73! 3730 2019-02-11 11:26:47Z moh.hefny
74! Formatting and clean-up (rvtils)
75!
76! 3710 2019-01-30 18:11:19Z suehring
77! Check if building type is set within a valid range.
78!
79! 3705 2019-01-29 19:56:39Z suehring
80! make nzb_wall public, required for virtual-measurements
81!
82! 3704 2019-01-29 19:51:41Z suehring
83! Some interface calls moved to module_interface + cleanup
84!
85! 3655 2019-01-07 16:51:22Z knoop
86! Implementation of the PALM module interface
87!
88! 3636 2018-12-19 13:48:34Z raasch
89! nopointer option removed
90!
91! 3614 2018-12-10 07:05:46Z raasch
92! unused variables removed
93!
94! 3607 2018-12-07 11:56:58Z suehring
95! Output of radiation-related quantities migrated to radiation_model_mod.
96!
97! 3597 2018-12-04 08:40:18Z maronga
98! Fixed calculation method of near surface air potential temperature at 10 cm
99! and moved to surface_layer_fluxes. Removed unnecessary _eb strings.
100!
101! 3524 2018-11-14 13:36:44Z raasch
102! bugfix concerning allocation of t_surf_wall_v
103!
104! 3502 2018-11-07 14:45:23Z suehring
105! Disable initialization of building roofs with ground-floor-level properties,
106! since this causes strong oscillations of surface temperature during the
107! spinup.
108!
109! 3469 2018-10-30 20:05:07Z kanani
110! Add missing PUBLIC variables for new indoor model
111!
112! 3449 2018-10-29 19:36:56Z suehring
113! Bugfix: Fix average arrays allocations in usm_3d_data_averaging (J.Resler)
114! Bugfix: Fix reading wall temperatures (J.Resler)
115! Bugfix: Fix treating of outputs for wall temperature and sky view factors (J.Resler)
116!
117!
118! 3435 2018-10-26 18:25:44Z gronemeier
119! Bugfix: allocate gamma_w_green_sat until nzt_wall+1
120!
121! 3418 2018-10-24 16:07:39Z kanani
122! (rvtils, srissman)
123! -Updated building databse, two green roof types (ind_green_type_roof)
124! -Latent heat flux for green walls and roofs, new output of latent heatflux
125!  and soil water content of green roof substrate
126! -t_surf changed to t_surf_wall
127! -Added namelist parameter usm_wall_mod for lower wall tendency
128!  of first two wall layers during spinup
129! -Window calculations deactivated during spinup
130!
131! 3382 2018-10-19 13:10:32Z knoop
132! Bugix: made array declaration Fortran Standard conform
133!
134! 3378 2018-10-19 12:34:59Z kanani
135! merge from radiation branch (r3362) into trunk
136! (moh.hefny):
137! - check the requested output variables if they are correct
138! - added unscheduled_radiation_calls switch to control force_radiation_call
139! - minor formate changes
140!
141! 3371 2018-10-18 13:40:12Z knoop
142! Set flag indicating that albedo at urban surfaces is already initialized
143!
144! 3347 2018-10-15 14:21:08Z suehring
145! Enable USM initialization with default building parameters in case no static
146! input file exist.
147!
148! 3343 2018-10-15 10:38:52Z suehring
149! Add output variables usm_rad_pc_inlw, usm_rad_pc_insw*
150!
151! 3274 2018-09-24 15:42:55Z knoop
152! Modularization of all bulk cloud physics code components
153!
154! 3248 2018-09-14 09:42:06Z sward
155! Minor formating changes
156!
157! 3246 2018-09-13 15:14:50Z sward
158! Added error handling for input namelist via parin_fail_message
159!
160! 3241 2018-09-12 15:02:00Z raasch
161! unused variables removed
162!
163! 3223 2018-08-30 13:48:17Z suehring
164! Bugfix for commit 3222
165!
166! 3222 2018-08-30 13:35:35Z suehring
167! Introduction of surface array for type and its name
168!
169! 3203 2018-08-23 10:48:36Z suehring
170! Revise bulk parameter for emissivity at ground-floor level
171!
172! 3196 2018-08-13 12:26:14Z maronga
173! Added maximum aerodynamic resistance of 300 for horiztonal surfaces.
174!
175! 3176 2018-07-26 17:12:48Z suehring
176! Bugfix, update virtual potential surface temparture, else heat fluxes on
177! roofs might become unphysical
178!
179! 3152 2018-07-19 13:26:52Z suehring
180! Initialize q_surface, which might be used in surface_layer_fluxes
181!
182! 3151 2018-07-19 08:45:38Z raasch
183! remaining preprocessor define strings __check removed
184!
185! 3136 2018-07-16 14:48:21Z suehring
186! Limit also roughness length for heat and moisture where necessary
187!
188! 3123 2018-07-12 16:21:53Z suehring
189! Correct working precision for INTEGER number
190!
191! 3115 2018-07-10 12:49:26Z suehring
192! Additional building type to represent bridges
193!
194! 3091 2018-06-28 16:20:35Z suehring
195! - Limit aerodynamic resistance at vertical walls.
196! - Add check for local roughness length not exceeding surface-layer height and
197!   limit roughness length where necessary.
198!
199! 3065 2018-06-12 07:03:02Z Giersch
200! Unused array dxdir was removed, dz was replaced by dzu to consider vertical
201! grid stretching
202!
203! 3049 2018-05-29 13:52:36Z Giersch
204! Error messages revised
205!
206! 3045 2018-05-28 07:55:41Z Giersch
207! Error message added
208!
209! 3029 2018-05-23 12:19:17Z raasch
210! bugfix: close unit 151 instead of 90
211!
212! 3014 2018-05-09 08:42:38Z maronga
213! Added pc_transpiration_rate
214!
215! 2977 2018-04-17 10:27:57Z kanani
216! Implement changes from branch radiation (r2948-2971) with minor modifications.
217! (moh.hefny):
218! Extended exn for all model domain height to avoid the need to get nzut.
219!
220! 2963 2018-04-12 14:47:44Z suehring
221! Introduce index for vegetation/wall, pavement/green-wall and water/window
222! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
223!
224! 2943 2018-04-03 16:17:10Z suehring
225! Calculate exner function at all height levels and remove some un-used
226! variables.
227!
228! 2932 2018-03-26 09:39:22Z maronga
229! renamed urban_surface_par to urban_surface_parameters
230!
231! 2921 2018-03-22 15:05:23Z Giersch
232! The activation of spinup has been moved to parin
233!
234! 2920 2018-03-22 11:22:01Z kanani
235! Remove unused pcbl, npcbl from ONLY list
236! moh.hefny:
237! Fixed bugs introduced by new structures and by moving radiation interaction
238! into radiation_model_mod.f90.
239! Bugfix: usm data output 3D didn't respect directions
240!
241! 2906 2018-03-19 08:56:40Z Giersch
242! Local variable ids has to be initialized with a value of -1 in
243! usm_3d_data_averaging
244!
245! 2894 2018-03-15 09:17:58Z Giersch
246! Calculations of the index range of the subdomain on file which overlaps with
247! the current subdomain are already done in read_restart_data_mod,
248! usm_read/write_restart_data have been renamed to usm_r/wrd_local, variable
249! named found has been introduced for checking if restart data was found,
250! reading of restart strings has been moved completely to
251! read_restart_data_mod, usm_rrd_local is already inside the overlap loop
252! programmed in read_restart_data_mod, SAVE attribute added where necessary,
253! deallocation and allocation of some arrays have been changed to take care of
254! different restart files that can be opened (index i), the marker *** end usm
255! *** is not necessary anymore, strings and their respective lengths are
256! written out and read now in case of restart runs to get rid of prescribed
257! character lengths
258!
259! 2805 2018-02-14 17:00:09Z suehring
260! Initialization of resistances.
261!
262! 2797 2018-02-08 13:24:35Z suehring
263! Comment concerning output of ground-heat flux added.
264!
265! 2766 2018-01-22 17:17:47Z kanani
266! Removed redundant commas, added some blanks
267!
268! 2765 2018-01-22 11:34:58Z maronga
269! Major bugfix in calculation of f_shf. Adjustment of roughness lengths in
270! building_pars
271!
272! 2750 2018-01-15 16:26:51Z knoop
273! Move flag plant canopy to modules
274!
275! 2737 2018-01-11 14:58:11Z kanani
276! Removed unused variables t_surf_whole...
277!
278! 2735 2018-01-11 12:01:27Z suehring
279! resistances are saved in surface attributes
280!
281! 2723 2018-01-05 09:27:03Z maronga
282! Bugfix for spinups (end_time was increased twice in case of LSM + USM runs)
283!
284! 2720 2018-01-02 16:27:15Z kanani
285! Correction of comment
286!
287! 2718 2018-01-02 08:49:38Z maronga
288! Corrected "Former revisions" section
289!
290! 2705 2017-12-18 11:26:23Z maronga
291! Changes from last commit documented
292!
293! 2703 2017-12-15 20:12:38Z maronga
294! Workaround for calculation of r_a
295!
296! 2696 2017-12-14 17:12:51Z kanani
297! - Change in file header (GPL part)
298! - Bugfix in calculation of pt_surface and related fluxes. (BM)
299! - Do not write surface temperatures onto pt array as this might cause
300!   problems with nesting. (MS)
301! - Revised calculation of pt1 (now done in surface_layer_fluxes).
302!   Bugfix, f_shf_window and f_shf_green were not set at vertical surface
303!   elements. (MS)
304! - merged with branch ebsolver
305!   green building surfaces do not evaporate yet
306!   properties of green wall layers and window layers are taken from wall layers
307!   this input data is missing. (RvT)
308! - Merged with branch radiation (developed by Mohamed Salim)
309! - Revised initialization. (MS)
310! - Rename emiss_surf into emissivity, roughness_wall into z0, albedo_surf into
311!   albedo. (MS)
312! - Move first call of usm_radiatin from usm_init to init_3d_model
313! - fixed problem with near surface temperature
314! - added near surface temperature pt_10cm_h(m), pt_10cm_v(l)%t(m)
315! - does not work with temp profile including stability, ol
316!   pt_10cm = pt1 now
317! - merged with 2357 bugfix, error message for nopointer version
318! - added indoor model coupling with wall heat flux
319! - added green substrate/ dry vegetation layer for buildings
320! - merged with 2232 new surface-type structure
321! - added transmissivity of window tiles
322! - added MOSAIK tile approach for 3 different surfaces (RvT)
323!
324! 2583 2017-10-26 13:58:38Z knoop
325! Bugfix: reverted MPI_Win_allocate_cptr introduction in last commit
326!
327! 2582 2017-10-26 13:19:46Z hellstea
328! Workaround for gnufortran compiler added in usm_calc_svf. CALL MPI_Win_allocate is
329! replaced by CALL MPI_Win_allocate_cptr if defined ( __gnufortran ).
330!
331! 2544 2017-10-13 18:09:32Z maronga
332! Date and time quantities are now read from date_and_time_mod. Solar constant is
333! read from radiation_model_mod
334!
335! 2516 2017-10-04 11:03:04Z suehring
336! Remove tabs
337!
338! 2514 2017-10-04 09:52:37Z suehring
339! upper bounds of 3d output changed from nx+1,ny+1 to nx,ny
340! no output of ghost layer data
341!
342! 2350 2017-08-15 11:48:26Z kanani
343! Bugfix and error message for nopointer version.
344! Additional "! defined(__nopointer)" as workaround to enable compilation of
345! nopointer version.
346!
347! 2318 2017-07-20 17:27:44Z suehring
348! Get topography top index via Function call
349!
350! 2317 2017-07-20 17:27:19Z suehring
351! Bugfix: adjust output of shf. Added support for spinups
352!
353! 2287 2017-06-15 16:46:30Z suehring
354! Bugfix in determination topography-top index
355!
356! 2269 2017-06-09 11:57:32Z suehring
357! Enable restart runs with different number of PEs
358! Bugfixes nopointer branch
359!
360! 2258 2017-06-08 07:55:13Z suehring
361! Bugfix, add pre-preprocessor directives to enable non-parrallel mode
362!
363! 2233 2017-05-30 18:08:54Z suehring
364!
365! 2232 2017-05-30 17:47:52Z suehring
366! Adjustments according to new surface-type structure. Remove usm_wall_heat_flux;
367! insteat, heat fluxes are directly applied in diffusion_s.
368!
369! 2213 2017-04-24 15:10:35Z kanani
370! Removal of output quantities usm_lad and usm_canopy_hr
371!
372! 2209 2017-04-19 09:34:46Z kanani
373! cpp switch __mpi3 removed,
374! minor formatting,
375! small bugfix for division by zero (Krc)
376!
377! 2113 2017-01-12 13:40:46Z kanani
378! cpp switch __mpi3 added for MPI-3 standard code (Ketelsen)
379!
380! 2071 2016-11-17 11:22:14Z maronga
381! Small bugfix (Resler)
382!
383! 2031 2016-10-21 15:11:58Z knoop
384! renamed variable rho to rho_ocean
385!
386! 2024 2016-10-12 16:42:37Z kanani
387! Bugfixes in deallocation of array plantt and reading of csf/csfsurf,
388! optimization of MPI-RMA operations,
389! declaration of pcbl as integer,
390! renamed usm_radnet -> usm_rad_net, usm_canopy_khf -> usm_canopy_hr,
391! splitted arrays svf -> svf & csf, svfsurf -> svfsurf & csfsurf,
392! use of new control parameter varnamelength,
393! added output variables usm_rad_ressw, usm_rad_reslw,
394! minor formatting changes,
395! minor optimizations.
396!
397! 2011 2016-09-19 17:29:57Z kanani
398! Major reformatting according to PALM coding standard (comments, blanks,
399! alphabetical ordering, etc.),
400! removed debug_prints,
401! removed auxiliary SUBROUTINE get_usm_info, instead, USM flag urban_surface is
402! defined in MODULE control_parameters (modules.f90) to avoid circular
403! dependencies,
404! renamed canopy_heat_flux to pc_heating_rate, as meaning of quantity changed.
405!
406! 2007 2016-08-24 15:47:17Z kanani
407! Initial revision
408!
409!
410! Description:
411! ------------
412! 2016/6/9 - Initial version of the USM (Urban Surface Model)
413!            authors: Jaroslav Resler, Pavel Krc
414!                     (Czech Technical University in Prague and Institute of
415!                      Computer Science of the Czech Academy of Sciences, Prague)
416!            with contributions: Michal Belda, Nina Benesova, Ondrej Vlcek
417!            partly inspired by PALM LSM (B. Maronga)
418!            parameterizations of Ra checked with TUF3D (E. S. Krayenhoff)
419!> Module for Urban Surface Model (USM)
420!> The module includes:
421!>    1. radiation model with direct/diffuse radiation, shading, reflections
422!>       and integration with plant canopy
423!>    2. wall and wall surface model
424!>    3. surface layer energy balance
425!>    4. anthropogenic heat (only from transportation so far)
426!>    5. necessary auxiliary subroutines (reading inputs, writing outputs,
427!>       restart simulations, ...)
428!> It also make use of standard radiation and integrates it into
429!> urban surface model.
430!>
431!> Further work:
432!> -------------
433!> 1. Remove global arrays surfouts, surfoutl and only keep track of radiosity
434!>    from surfaces that are visible from local surfaces (i.e. there is a SVF
435!>    where target is local). To do that, radiosity will be exchanged after each
436!>    reflection step using MPI_Alltoall instead of current MPI_Allgather.
437!>
438!> 2. Temporarily large values of surface heat flux can be observed, up to
439!>    1.2 Km/s, which seem to be not realistic.
440!>
441!> @todo Output of _av variables in case of restarts
442!> @todo Revise flux conversion in energy-balance solver
443!> @todo Check optimizations for RMA operations
444!> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi)
445!> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
446!>       factor 3 between min and max time
447!> @todo Check divisions in wtend (etc.) calculations for possible division
448!>       by zero, e.g. in case fraq(0,m) + fraq(1,m) = 0?!
449!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
450!> @todo Move plant canopy stuff into plant canopy code
451!------------------------------------------------------------------------------!
452 MODULE urban_surface_mod
453
454    USE arrays_3d,                                                             &
455        ONLY:  hyp, zu, pt, p, u, v, w, tend, exner, hyrho, prr, q, ql, vpt
456
457    USE calc_mean_profile_mod,                                                 &
458        ONLY:  calc_mean_profile
459
460    USE basic_constants_and_equations_mod,                                     &
461        ONLY:  c_p, g, kappa, pi, r_d, rho_l, l_v, sigma_sb
462
463    USE control_parameters,                                                    &
464        ONLY:  coupling_start_time, topography,                                &
465               debug_output, debug_string,                                     &
466               dt_3d, humidity, indoor_model,                                  &
467               intermediate_timestep_count, initializing_actions,              &
468               intermediate_timestep_count_max, simulated_time, end_time,      &
469               timestep_scheme, tsc, coupling_char, io_blocks, io_group,       &
470               message_string, time_since_reference_point, surface_pressure,   &
471               pt_surface, large_scale_forcing, lsf_surf, spinup,              &
472               spinup_pt_mean, spinup_time, time_do3d, dt_do3d,                &
473               average_count_3d, varnamelength, urban_surface, dz
474
475    USE bulk_cloud_model_mod,                                                  &
476        ONLY: bulk_cloud_model, precipitation
477               
478    USE cpulog,                                                                &
479        ONLY:  cpu_log, log_point, log_point_s
480
481    USE date_and_time_mod,                                                     &
482        ONLY:  time_utc_init
483
484    USE grid_variables,                                                        &
485        ONLY:  dx, dy, ddx, ddy, ddx2, ddy2
486
487    USE indices,                                                               &
488        ONLY:  nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys,    &
489               nysg, nzb, nzt, nbgp, wall_flags_0
490
491    USE, INTRINSIC :: iso_c_binding 
492
493    USE kinds
494             
495    USE pegrid
496       
497    USE radiation_model_mod,                                                   &
498        ONLY:  albedo_type, radiation_interaction,                             &
499               radiation, rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,        &
500               force_radiation_call, iup_u, inorth_u, isouth_u, ieast_u,       &
501               iwest_u, iup_l, inorth_l, isouth_l, ieast_l, iwest_l, id,       &
502               iz, iy, ix,  nsurf, idsvf, ndsvf,                               &
503               idcsf, ndcsf, kdcsf, pct,                                       &
504               nz_urban_b, nz_urban_t, unscheduled_radiation_calls
505
506    USE statistics,                                                            &
507        ONLY:  hom, statistic_regions
508
509    USE surface_mod,                                                           &
510        ONLY:  get_topography_top_index_ji, get_topography_top_index,          &
511               ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h,           &
512               surf_usm_v, surface_restore_elements
513
514
515    IMPLICIT NONE
516
517!
518!-- USM model constants
519
520    REAL(wp), PARAMETER ::                     &
521              b_ch               = 6.04_wp,    &  !< Clapp & Hornberger exponent
522              lambda_h_green_dry = 0.19_wp,    &  !< heat conductivity for dry soil   
523              lambda_h_green_sm  = 3.44_wp,    &  !< heat conductivity of the soil matrix
524              lambda_h_water     = 0.57_wp,    &  !< heat conductivity of water
525              psi_sat            = -0.388_wp,  &  !< soil matrix potential at saturation
526              rho_c_soil         = 2.19E6_wp,  &  !< volumetric heat capacity of soil
527              rho_c_water        = 4.20E6_wp      !< volumetric heat capacity of water
528!               m_max_depth        = 0.0002_wp     ! Maximum capacity of the water reservoir (m)
529
530!
531!-- Soil parameters I           alpha_vg,      l_vg_green,    n_vg, gamma_w_green_sat
532    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: soil_pars = RESHAPE( (/     &
533                                 3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, &  !< soil 1
534                                 3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, &  !< soil 2
535                                 0.83_wp, -0.588_wp, 1.25_wp,  0.26E-6_wp, &  !< soil 3
536                                 3.67_wp, -1.977_wp, 1.10_wp,  2.87E-6_wp, &  !< soil 4
537                                 2.65_wp,  2.500_wp, 1.10_wp,  1.74E-6_wp, &  !< soil 5
538                                 1.30_wp,  0.400_wp, 1.20_wp,  0.93E-6_wp, &  !< soil 6
539                                 0.00_wp,  0.00_wp,  0.00_wp,  0.57E-6_wp  &  !< soil 7
540                                 /), (/ 4, 7 /) )
541
542!
543!-- Soil parameters II              swc_sat,     fc,   wilt,    swc_res 
544    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: m_soil_pars = RESHAPE( (/ &
545                                 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp, &  !< soil 1
546                                 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp, &  !< soil 2
547                                 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp, &  !< soil 3
548                                 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp, &  !< soil 4
549                                 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp, &  !< soil 5
550                                 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp, &  !< soil 6
551                                 0.472_wp, 0.323_wp, 0.171_wp, 0.000_wp  &  !< soil 7
552                                 /), (/ 4, 7 /) )
553!
554!-- value 9999999.9_wp -> generic available or user-defined value must be set
555!-- otherwise -> no generic variable and user setting is optional
556    REAL(wp) :: alpha_vangenuchten = 9999999.9_wp,      &  !< NAMELIST alpha_vg
557                field_capacity = 9999999.9_wp,          &  !< NAMELIST fc
558                hydraulic_conductivity = 9999999.9_wp,  &  !< NAMELIST gamma_w_green_sat
559                l_vangenuchten = 9999999.9_wp,          &  !< NAMELIST l_vg
560                n_vangenuchten = 9999999.9_wp,          &  !< NAMELIST n_vg
561                residual_moisture = 9999999.9_wp,       &  !< NAMELIST m_res
562                saturation_moisture = 9999999.9_wp,     &  !< NAMELIST m_sat
563                wilting_point = 9999999.9_wp               !< NAMELIST m_wilt
564   
565!
566!-- configuration parameters (they can be setup in PALM config)
567    LOGICAL ::  usm_material_model = .TRUE.        !< flag parameter indicating wheather the  model of heat in materials is used
568    LOGICAL ::  usm_anthropogenic_heat = .FALSE.   !< flag parameter indicating wheather the anthropogenic heat sources
569                                                   !< (e.g.transportation) are used
570    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
571    LOGICAL ::  read_wall_temp_3d = .FALSE.
572    LOGICAL ::  usm_wall_mod = .FALSE.             !< reduces conductivity of the first 2 wall layers by factor 0.1
573
574
575    INTEGER(iwp) ::  building_type = 1               !< default building type (preleminary setting)
576    INTEGER(iwp) ::  land_category = 2               !< default category for land surface
577    INTEGER(iwp) ::  wall_category = 2               !< default category for wall surface over pedestrian zone
578    INTEGER(iwp) ::  pedestrian_category = 2         !< default category for wall surface in pedestrian zone
579    INTEGER(iwp) ::  roof_category = 2               !< default category for root surface
580    REAL(wp)     ::  roughness_concrete = 0.001_wp   !< roughness length of average concrete surface
581!
582!-- Indices of input attributes in building_pars for (above) ground floor level
583    INTEGER(iwp) ::  ind_alb_wall_agfl     = 38   !< index in input list for albedo_type of wall above ground floor level
584    INTEGER(iwp) ::  ind_alb_wall_gfl      = 66   !< index in input list for albedo_type of wall ground floor level
585    INTEGER(iwp) ::  ind_alb_wall_r        = 101  !< index in input list for albedo_type of wall roof
586    INTEGER(iwp) ::  ind_alb_green_agfl    = 39   !< index in input list for albedo_type of green above ground floor level
587    INTEGER(iwp) ::  ind_alb_green_gfl     = 78   !< index in input list for albedo_type of green ground floor level
588    INTEGER(iwp) ::  ind_alb_green_r       = 117  !< index in input list for albedo_type of green roof
589    INTEGER(iwp) ::  ind_alb_win_agfl      = 40   !< index in input list for albedo_type of window fraction above ground floor level
590    INTEGER(iwp) ::  ind_alb_win_gfl       = 77   !< index in input list for albedo_type of window fraction ground floor level
591    INTEGER(iwp) ::  ind_alb_win_r         = 115  !< index in input list for albedo_type of window fraction roof
592    INTEGER(iwp) ::  ind_c_surface         = 45   !< index in input list for heat capacity wall surface
593    INTEGER(iwp) ::  ind_c_surface_green   = 48   !< index in input list for heat capacity green surface
594    INTEGER(iwp) ::  ind_c_surface_win     = 47   !< index in input list for heat capacity window surface
595    INTEGER(iwp) ::  ind_emis_wall_agfl    = 14   !< index in input list for wall emissivity, above ground floor level
596    INTEGER(iwp) ::  ind_emis_wall_gfl     = 32   !< index in input list for wall emissivity, ground floor level
597    INTEGER(iwp) ::  ind_emis_wall_r       = 100  !< index in input list for wall emissivity, roof
598    INTEGER(iwp) ::  ind_emis_green_agfl   = 15   !< index in input list for green emissivity, above ground floor level
599    INTEGER(iwp) ::  ind_emis_green_gfl    = 34   !< index in input list for green emissivity, ground floor level
600    INTEGER(iwp) ::  ind_emis_green_r      = 116  !< index in input list for green emissivity, roof
601    INTEGER(iwp) ::  ind_emis_win_agfl     = 16   !< index in input list for window emissivity, above ground floor level
602    INTEGER(iwp) ::  ind_emis_win_gfl      = 33   !< index in input list for window emissivity, ground floor level
603    INTEGER(iwp) ::  ind_emis_win_r        = 113  !< index in input list for window emissivity, roof
604    INTEGER(iwp) ::  ind_gflh              = 20   !< index in input list for ground floor level height
605    INTEGER(iwp) ::  ind_green_frac_w_agfl = 2    !< index in input list for green fraction on wall, above ground floor level
606    INTEGER(iwp) ::  ind_green_frac_w_gfl  = 23   !< index in input list for green fraction on wall, ground floor level
607    INTEGER(iwp) ::  ind_green_frac_r_agfl = 3    !< index in input list for green fraction on roof, above ground floor level
608    INTEGER(iwp) ::  ind_green_frac_r_gfl  = 24   !< index in input list for green fraction on roof, ground floor level
609    INTEGER(iwp) ::  ind_hc1_agfl          = 6    !< index in input list for heat capacity at first wall layer,
610                                                  !< above ground floor level
611    INTEGER(iwp) ::  ind_hc1_gfl           = 26   !< index in input list for heat capacity at first wall layer, ground floor level
612    INTEGER(iwp) ::  ind_hc1_wall_r        = 94   !< index in input list for heat capacity at first wall layer, roof
613    INTEGER(iwp) ::  ind_hc1_win_agfl      = 83   !< index in input list for heat capacity at first window layer,
614                                                  !< above ground floor level
615    INTEGER(iwp) ::  ind_hc1_win_gfl       = 71   !< index in input list for heat capacity at first window layer,
616                                                  !< ground floor level
617    INTEGER(iwp) ::  ind_hc1_win_r         = 107  !< index in input list for heat capacity at first window layer, roof
618    INTEGER(iwp) ::  ind_hc2_agfl          = 7    !< index in input list for heat capacity at second wall layer,
619                                                  !< above ground floor level
620    INTEGER(iwp) ::  ind_hc2_gfl           = 27   !< index in input list for heat capacity at second wall layer, ground floor level
621    INTEGER(iwp) ::  ind_hc2_wall_r        = 95   !< index in input list for heat capacity at second wall layer, roof
622    INTEGER(iwp) ::  ind_hc2_win_agfl      = 84   !< index in input list for heat capacity at second window layer,
623                                                  !< above ground floor level
624    INTEGER(iwp) ::  ind_hc2_win_gfl       = 72   !< index in input list for heat capacity at second window layer,
625                                                  !< ground floor level
626    INTEGER(iwp) ::  ind_hc2_win_r         = 108  !< index in input list for heat capacity at second window layer, roof
627    INTEGER(iwp) ::  ind_hc3_agfl          = 8    !< index in input list for heat capacity at third wall layer,
628                                                  !< above ground floor level
629    INTEGER(iwp) ::  ind_hc3_gfl           = 28   !< index in input list for heat capacity at third wall layer, ground floor level
630    INTEGER(iwp) ::  ind_hc3_wall_r        = 96   !< index in input list for heat capacity at third wall layer, roof
631    INTEGER(iwp) ::  ind_hc3_win_agfl      = 85   !< index in input list for heat capacity at third window layer,
632                                                  !< above ground floor level
633    INTEGER(iwp) ::  ind_hc3_win_gfl       = 73   !< index in input list for heat capacity at third window layer,
634                                                  !< ground floor level
635    INTEGER(iwp) ::  ind_hc3_win_r         = 109  !< index in input list for heat capacity at third window layer, roof
636    INTEGER(iwp) ::  ind_indoor_target_temp_summer = 12
637    INTEGER(iwp) ::  ind_indoor_target_temp_winter = 13
638    INTEGER(iwp) ::  ind_lai_r_agfl        = 4    !< index in input list for LAI on roof, above ground floor level
639    INTEGER(iwp) ::  ind_lai_r_gfl         = 4  !< index in input list for LAI on roof, ground floor level
640    INTEGER(iwp) ::  ind_lai_w_agfl        = 5    !< index in input list for LAI on wall, above ground floor level
641    INTEGER(iwp) ::  ind_lai_w_gfl         = 25   !< index in input list for LAI on wall, ground floor level
642    INTEGER(iwp) ::  ind_lambda_surf       = 46   !< index in input list for thermal conductivity of wall surface
643    INTEGER(iwp) ::  ind_lambda_surf_green = 50   !< index in input list for thermal conductivity of green surface
644    INTEGER(iwp) ::  ind_lambda_surf_win   = 49   !< index in input list for thermal conductivity of window surface
645    INTEGER(iwp) ::  ind_tc1_agfl          = 9    !< index in input list for thermal conductivity at first wall layer,
646                                                  !< above ground floor level
647    INTEGER(iwp) ::  ind_tc1_gfl           = 29   !< index in input list for thermal conductivity at first wall layer,
648                                                  !< ground floor level
649    INTEGER(iwp) ::  ind_tc1_wall_r        = 97   !< index in input list for thermal conductivity at first wall layer, roof
650    INTEGER(iwp) ::  ind_tc1_win_agfl      = 86   !< index in input list for thermal conductivity at first window layer,
651                                                  !< above ground floor level
652    INTEGER(iwp) ::  ind_tc1_win_gfl       = 74   !< index in input list for thermal conductivity at first window layer,
653                                                  !< ground floor level
654    INTEGER(iwp) ::  ind_tc1_win_r         = 110  !< index in input list for thermal conductivity at first window layer, roof
655    INTEGER(iwp) ::  ind_tc2_agfl          = 10   !< index in input list for thermal conductivity at second wall layer,
656                                                  !< above ground floor level
657    INTEGER(iwp) ::  ind_tc2_gfl           = 30   !< index in input list for thermal conductivity at second wall layer,
658                                                  !< ground floor level
659    INTEGER(iwp) ::  ind_tc2_wall_r        = 98   !< index in input list for thermal conductivity at second wall layer, roof
660    INTEGER(iwp) ::  ind_tc2_win_agfl      = 87   !< index in input list for thermal conductivity at second window layer,
661                                                  !< above ground floor level
662    INTEGER(iwp) ::  ind_tc2_win_gfl       = 75   !< index in input list for thermal conductivity at second window layer,
663                                                  !< ground floor level
664    INTEGER(iwp) ::  ind_tc2_win_r         = 111  !< index in input list for thermal conductivity at second window layer,
665                                                  !< ground floor level
666    INTEGER(iwp) ::  ind_tc3_agfl          = 11   !< index in input list for thermal conductivity at third wall layer,
667                                                  !< above ground floor level
668    INTEGER(iwp) ::  ind_tc3_gfl           = 31   !< index in input list for thermal conductivity at third wall layer,
669                                                  !< ground floor level
670    INTEGER(iwp) ::  ind_tc3_wall_r        = 99   !< index in input list for thermal conductivity at third wall layer, roof
671    INTEGER(iwp) ::  ind_tc3_win_agfl      = 88   !< index in input list for thermal conductivity at third window layer,
672                                                  !< above ground floor level
673    INTEGER(iwp) ::  ind_tc3_win_gfl       = 76   !< index in input list for thermal conductivity at third window layer,
674                                                  !< ground floor level
675    INTEGER(iwp) ::  ind_tc3_win_r         = 112  !< index in input list for thermal conductivity at third window layer, roof
676    INTEGER(iwp) ::  ind_thick_1_agfl      = 41   !< index for wall layer thickness - 1st layer above ground floor level
677    INTEGER(iwp) ::  ind_thick_1_gfl       = 62   !< index for wall layer thickness - 1st layer ground floor level
678    INTEGER(iwp) ::  ind_thick_1_wall_r    = 90   !< index for wall layer thickness - 1st layer roof
679    INTEGER(iwp) ::  ind_thick_1_win_agfl  = 79   !< index for window layer thickness - 1st layer above ground floor level
680    INTEGER(iwp) ::  ind_thick_1_win_gfl   = 67   !< index for window layer thickness - 1st layer ground floor level
681    INTEGER(iwp) ::  ind_thick_1_win_r     = 103  !< index for window layer thickness - 1st layer roof
682    INTEGER(iwp) ::  ind_thick_2_agfl      = 42   !< index for wall layer thickness - 2nd layer above ground floor level
683    INTEGER(iwp) ::  ind_thick_2_gfl       = 63   !< index for wall layer thickness - 2nd layer ground floor level
684    INTEGER(iwp) ::  ind_thick_2_wall_r    = 91   !< index for wall layer thickness - 2nd layer roof
685    INTEGER(iwp) ::  ind_thick_2_win_agfl  = 80   !< index for window layer thickness - 2nd layer above ground floor level
686    INTEGER(iwp) ::  ind_thick_2_win_gfl   = 68   !< index for window layer thickness - 2nd layer ground floor level
687    INTEGER(iwp) ::  ind_thick_2_win_r     = 104  !< index for window layer thickness - 2nd layer roof
688    INTEGER(iwp) ::  ind_thick_3_agfl      = 43   !< index for wall layer thickness - 3rd layer above ground floor level
689    INTEGER(iwp) ::  ind_thick_3_gfl       = 64   !< index for wall layer thickness - 3rd layer ground floor level
690    INTEGER(iwp) ::  ind_thick_3_wall_r    = 92   !< index for wall layer thickness - 3rd layer roof
691    INTEGER(iwp) ::  ind_thick_3_win_agfl  = 81   !< index for window layer thickness - 3rd layer above ground floor level
692    INTEGER(iwp) ::  ind_thick_3_win_gfl   = 69   !< index for window layer thickness - 3rd layer ground floor level 
693    INTEGER(iwp) ::  ind_thick_3_win_r     = 105  !< index for window layer thickness - 3rd layer roof
694    INTEGER(iwp) ::  ind_thick_4_agfl      = 44   !< index for wall layer thickness - 4th layer above ground floor level
695    INTEGER(iwp) ::  ind_thick_4_gfl       = 65   !< index for wall layer thickness - 4th layer ground floor level
696    INTEGER(iwp) ::  ind_thick_4_wall_r    = 93   !< index for wall layer thickness - 4st layer roof
697    INTEGER(iwp) ::  ind_thick_4_win_agfl  = 82   !< index for window layer thickness - 4th layer above ground floor level
698    INTEGER(iwp) ::  ind_thick_4_win_gfl   = 70   !< index for window layer thickness - 4th layer ground floor level
699    INTEGER(iwp) ::  ind_thick_4_win_r     = 106  !< index for window layer thickness - 4th layer roof
700    INTEGER(iwp) ::  ind_trans_agfl        = 17   !< index in input list for window transmissivity, above ground floor level
701    INTEGER(iwp) ::  ind_trans_gfl         = 35   !< index in input list for window transmissivity, ground floor level
702    INTEGER(iwp) ::  ind_trans_r           = 114  !< index in input list for window transmissivity, roof
703    INTEGER(iwp) ::  ind_wall_frac_agfl    = 0    !< index in input list for wall fraction, above ground floor level
704    INTEGER(iwp) ::  ind_wall_frac_gfl     = 21   !< index in input list for wall fraction, ground floor level
705    INTEGER(iwp) ::  ind_wall_frac_r       = 89   !< index in input list for wall fraction, roof
706    INTEGER(iwp) ::  ind_win_frac_agfl     = 1    !< index in input list for window fraction, above ground floor level
707    INTEGER(iwp) ::  ind_win_frac_gfl      = 22   !< index in input list for window fraction, ground floor level
708    INTEGER(iwp) ::  ind_win_frac_r        = 102  !< index in input list for window fraction, roof
709    INTEGER(iwp) ::  ind_z0_agfl           = 18   !< index in input list for z0, above ground floor level
710    INTEGER(iwp) ::  ind_z0_gfl            = 36   !< index in input list for z0, ground floor level
711    INTEGER(iwp) ::  ind_z0qh_agfl         = 19   !< index in input list for z0h / z0q, above ground floor level
712    INTEGER(iwp) ::  ind_z0qh_gfl          = 37   !< index in input list for z0h / z0q, ground floor level
713    INTEGER(iwp) ::  ind_green_type_roof   = 118  !< index in input list for type of green roof
714
715
716    REAL(wp)  ::  roof_height_limit = 4.0_wp         !< height for distinguish between land surfaces and roofs
717    REAL(wp)  ::  ground_floor_level = 4.0_wp        !< default ground floor level
718
719
720    CHARACTER(37), DIMENSION(0:7), PARAMETER :: building_type_name = (/     &
721                                   'user-defined                         ', &  !< type 0
722                                   'residential - 1950                   ', &  !< type  1
723                                   'residential 1951 - 2000              ', &  !< type  2
724                                   'residential 2001 -                   ', &  !< type  3
725                                   'office - 1950                        ', &  !< type  4
726                                   'office 1951 - 2000                   ', &  !< type  5
727                                   'office 2001 -                        ', &  !< type  6
728                                   'bridges                              '  &  !< type  7
729                                                                     /)
730
731
732!
733!-- Building facade/wall/green/window properties (partly according to PIDS).
734!-- Initialization of building_pars is outsourced to usm_init_pars. This is
735!-- needed because of the huge number of attributes given in building_pars
736!-- (>700), while intel and gfortran compiler have hard limit of continuation
737!-- lines of 511.
738    REAL(wp), DIMENSION(0:133,1:7) ::  building_pars
739!
740!-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls.
741    TYPE t_surf_vertical
742       REAL(wp), DIMENSION(:), ALLOCATABLE         :: t
743    END TYPE t_surf_vertical
744!
745!-- Type for wall temperatures at vertical walls. Is not necessary for horizontal walls.
746    TYPE t_wall_vertical
747       REAL(wp), DIMENSION(:,:), ALLOCATABLE       :: t
748    END TYPE t_wall_vertical
749
750    TYPE surf_type_usm
751       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_usm_1d  !< 1D prognostic variable
752       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_usm_2d  !< 2D prognostic variable
753    END TYPE surf_type_usm
754   
755    TYPE(surf_type_usm), POINTER  ::  m_liq_usm_h,        &  !< liquid water reservoir (m), horizontal surface elements
756                                      m_liq_usm_h_p          !< progn. liquid water reservoir (m), horizontal surface elements
757
758    TYPE(surf_type_usm), TARGET   ::  m_liq_usm_h_1,      &  !<
759                                      m_liq_usm_h_2          !<
760
761    TYPE(surf_type_usm), DIMENSION(:), POINTER  ::        &
762                                      m_liq_usm_v,        &  !< liquid water reservoir (m), vertical surface elements
763                                      m_liq_usm_v_p          !< progn. liquid water reservoir (m), vertical surface elements
764
765    TYPE(surf_type_usm), DIMENSION(0:3), TARGET   ::      &
766                                      m_liq_usm_v_1,      &  !<
767                                      m_liq_usm_v_2          !<
768
769    TYPE(surf_type_usm), TARGET ::  tm_liq_usm_h_m      !< liquid water reservoir tendency (m), horizontal surface elements
770    TYPE(surf_type_usm), DIMENSION(0:3), TARGET ::  tm_liq_usm_v_m      !< liquid water reservoir tendency (m),
771                                                                        !< vertical surface elements
772
773!
774!-- anthropogenic heat sources
775    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE        ::  aheat             !< daily average of anthropogenic heat (W/m2)
776    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  aheatprof         !< diurnal profiles of anthropogenic heat
777                                                                         !< for particular layers
778    INTEGER(iwp)                                   ::  naheatlayers = 1  !< number of layers of anthropogenic heat
779
780!
781!-- wall surface model
782!-- wall surface model constants
783    INTEGER(iwp), PARAMETER                        :: nzb_wall = 0       !< inner side of the wall model (to be switched)
784    INTEGER(iwp), PARAMETER                        :: nzt_wall = 3       !< outer side of the wall model (to be switched)
785    INTEGER(iwp), PARAMETER                        :: nzw = 4            !< number of wall layers (fixed for now)
786
787    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default        = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
788    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
789    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green  = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
790                                                                         !< normalized soil, wall and roof, window and
791                                                                         !<green layer depths (m/m)
792
793    REAL(wp)                                       :: wall_inner_temperature   = 295.0_wp    !< temperature of the inner wall
794                                                                                             !< surface (~22 degrees C) (K)
795    REAL(wp)                                       :: roof_inner_temperature   = 295.0_wp    !< temperature of the inner roof
796                                                                                             !< surface (~22 degrees C) (K)
797    REAL(wp)                                       :: soil_inner_temperature   = 288.0_wp    !< temperature of the deep soil
798                                                                                             !< (~15 degrees C) (K)
799    REAL(wp)                                       :: window_inner_temperature = 295.0_wp    !< temperature of the inner window
800                                                                                             !< surface (~22 degrees C) (K)
801
802    REAL(wp)                                       :: m_total = 0.0_wp  !< weighted total water content of the soil (m3/m3)
803    INTEGER(iwp)                                   :: soil_type
804
805!
806!-- surface and material model variables for walls, ground, roofs
807    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn                !< normalized wall layer depths (m)
808    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_window         !< normalized window layer depths (m)
809    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_green          !< normalized green layer depths (m)
810
811    REAL(wp), DIMENSION(:), POINTER                :: t_surf_wall_h
812    REAL(wp), DIMENSION(:), POINTER                :: t_surf_wall_h_p 
813    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h
814    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h_p 
815    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h
816    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h_p 
817
818    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_wall_h_1
819    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_wall_h_2
820    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_1
821    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_2
822    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_1
823    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_2
824
825    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v
826    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v_p
827    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v
828    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v_p
829    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v
830    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v_p
831
832    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_wall_v_1
833    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_wall_v_2
834    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_1
835    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_2
836    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_1
837    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_2
838
839!
840!-- Energy balance variables
841!-- parameters of the land, roof and wall surfaces
842
843    REAL(wp), DIMENSION(:,:), POINTER                :: t_wall_h, t_wall_h_p
844    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_1, t_wall_h_2
845    REAL(wp), DIMENSION(:,:), POINTER                :: t_window_h, t_window_h_p
846    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_1, t_window_h_2
847    REAL(wp), DIMENSION(:,:), POINTER                :: t_green_h, t_green_h_p
848    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_1, t_green_h_2
849    REAL(wp), DIMENSION(:,:), POINTER                :: swc_h, rootfr_h, wilt_h, fc_h, swc_sat_h, swc_h_p, swc_res_h
850    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: swc_h_1, rootfr_h_1, &
851                                                        wilt_h_1, fc_h_1, swc_sat_h_1, swc_h_2, swc_res_h_1
852   
853
854    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_wall_v, t_wall_v_p
855    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_1, t_wall_v_2
856    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_window_v, t_window_v_p
857    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_1, t_window_v_2
858    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_green_v, t_green_v_p
859    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_1, t_green_v_2
860    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: swc_v, swc_v_p
861    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: swc_v_1, swc_v_2
862
863!
864!-- Surface and material parameters classes (surface_type)
865!-- albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
866    INTEGER(iwp)                                   :: n_surface_types       !< number of the wall type categories
867    INTEGER(iwp), PARAMETER                        :: n_surface_params = 9  !< number of parameters for each type of the wall
868    INTEGER(iwp), PARAMETER                        :: ialbedo  = 1          !< albedo of the surface
869    INTEGER(iwp), PARAMETER                        :: iemiss   = 2          !< emissivity of the surface
870    INTEGER(iwp), PARAMETER                        :: ilambdas = 3          !< heat conductivity lambda S between surface
871                                                                            !< and material ( W m-2 K-1 )
872    INTEGER(iwp), PARAMETER                        :: irough   = 4          !< roughness length z0 for movements
873    INTEGER(iwp), PARAMETER                        :: iroughh  = 5          !< roughness length z0h for scalars
874                                                                            !< (heat, humidity,...)
875    INTEGER(iwp), PARAMETER                        :: icsurf   = 6          !< Surface skin layer heat capacity (J m-2 K-1 )
876    INTEGER(iwp), PARAMETER                        :: ithick   = 7          !< thickness of the surface (wall, roof, land)  ( m )
877    INTEGER(iwp), PARAMETER                        :: irhoC    = 8          !< volumetric heat capacity rho*C of
878                                                                            !< the material ( J m-3 K-1 )
879    INTEGER(iwp), PARAMETER                        :: ilambdah = 9          !< thermal conductivity lambda H
880                                                                            !< of the wall (W m-1 K-1 )
881    CHARACTER(12), DIMENSION(:), ALLOCATABLE       :: surface_type_names    !< names of wall types (used only for reports)
882    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        :: surface_type_codes    !< codes of wall types
883    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: surface_params        !< parameters of wall types
884
885!
886!-- interfaces of subroutines accessed from outside of this module
887    INTERFACE usm_3d_data_averaging
888       MODULE PROCEDURE usm_3d_data_averaging
889    END INTERFACE usm_3d_data_averaging
890
891    INTERFACE usm_boundary_condition
892       MODULE PROCEDURE usm_boundary_condition
893    END INTERFACE usm_boundary_condition
894
895    INTERFACE usm_check_data_output
896       MODULE PROCEDURE usm_check_data_output
897    END INTERFACE usm_check_data_output
898   
899    INTERFACE usm_check_parameters
900       MODULE PROCEDURE usm_check_parameters
901    END INTERFACE usm_check_parameters
902   
903    INTERFACE usm_data_output_3d
904       MODULE PROCEDURE usm_data_output_3d
905    END INTERFACE usm_data_output_3d
906   
907    INTERFACE usm_define_netcdf_grid
908       MODULE PROCEDURE usm_define_netcdf_grid
909    END INTERFACE usm_define_netcdf_grid
910
911    INTERFACE usm_init
912       MODULE PROCEDURE usm_init
913    END INTERFACE usm_init
914
915    INTERFACE usm_init_arrays
916       MODULE PROCEDURE usm_init_arrays
917    END INTERFACE usm_init_arrays
918
919    INTERFACE usm_material_heat_model
920       MODULE PROCEDURE usm_material_heat_model
921    END INTERFACE usm_material_heat_model
922   
923    INTERFACE usm_green_heat_model
924       MODULE PROCEDURE usm_green_heat_model
925    END INTERFACE usm_green_heat_model
926   
927    INTERFACE usm_parin
928       MODULE PROCEDURE usm_parin
929    END INTERFACE usm_parin
930
931    INTERFACE usm_rrd_local 
932       MODULE PROCEDURE usm_rrd_local
933    END INTERFACE usm_rrd_local
934
935    INTERFACE usm_surface_energy_balance
936       MODULE PROCEDURE usm_surface_energy_balance
937    END INTERFACE usm_surface_energy_balance
938   
939    INTERFACE usm_swap_timelevel
940       MODULE PROCEDURE usm_swap_timelevel
941    END INTERFACE usm_swap_timelevel
942       
943    INTERFACE usm_wrd_local
944       MODULE PROCEDURE usm_wrd_local
945    END INTERFACE usm_wrd_local
946
947   
948    SAVE
949
950    PRIVATE 
951
952!
953!-- Public functions
954    PUBLIC usm_boundary_condition, usm_check_parameters, usm_init,               &
955           usm_rrd_local,                                                        & 
956           usm_surface_energy_balance, usm_material_heat_model,                  &
957           usm_swap_timelevel, usm_check_data_output, usm_3d_data_averaging,     &
958           usm_data_output_3d, usm_define_netcdf_grid, usm_parin,                &
959           usm_wrd_local, usm_init_arrays
960
961!
962!-- Public parameters, constants and initial values
963    PUBLIC usm_anthropogenic_heat, usm_material_model, usm_wall_mod, &
964           usm_green_heat_model, building_pars,                      &
965           nzb_wall, nzt_wall, t_wall_h, t_wall_v,                   &
966           t_window_h, t_window_v, building_type
967
968
969
970 CONTAINS
971
972!------------------------------------------------------------------------------!
973! Description:
974! ------------
975!> This subroutine creates the necessary indices of the urban surfaces
976!> and plant canopy and it allocates the needed arrays for USM
977!------------------------------------------------------------------------------!
978    SUBROUTINE usm_init_arrays
979   
980        IMPLICIT NONE
981       
982        INTEGER(iwp) ::  l
983
984        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'start' )
985
986!
987!--     Allocate radiation arrays which are part of the new data type.
988!--     For horizontal surfaces.
989        ALLOCATE ( surf_usm_h%surfhf(1:surf_usm_h%ns)    )
990        ALLOCATE ( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
991!
992!--     For vertical surfaces
993        DO  l = 0, 3
994           ALLOCATE ( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns)    )
995           ALLOCATE ( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
996        ENDDO
997
998!
999!--     Wall surface model
1000!--     allocate arrays for wall surface model and define pointers
1001!--     allocate array of wall types and wall parameters
1002        ALLOCATE ( surf_usm_h%surface_types(1:surf_usm_h%ns)      )
1003        ALLOCATE ( surf_usm_h%building_type(1:surf_usm_h%ns)      )
1004        ALLOCATE ( surf_usm_h%building_type_name(1:surf_usm_h%ns) )
1005        surf_usm_h%building_type      = 0
1006        surf_usm_h%building_type_name = 'none'
1007        DO  l = 0, 3
1008           ALLOCATE ( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns)      )
1009           ALLOCATE ( surf_usm_v(l)%building_type(1:surf_usm_v(l)%ns)      )
1010           ALLOCATE ( surf_usm_v(l)%building_type_name(1:surf_usm_v(l)%ns) )
1011           surf_usm_v(l)%building_type      = 0
1012           surf_usm_v(l)%building_type_name = 'none'
1013        ENDDO
1014!
1015!--     Allocate albedo_type and albedo. Each surface element
1016!--     has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction.
1017        ALLOCATE ( surf_usm_h%albedo_type(0:2,1:surf_usm_h%ns) )
1018        ALLOCATE ( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)      )
1019        surf_usm_h%albedo_type = albedo_type
1020        DO  l = 0, 3
1021           ALLOCATE ( surf_usm_v(l)%albedo_type(0:2,1:surf_usm_v(l)%ns) )
1022           ALLOCATE ( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns)      )
1023           surf_usm_v(l)%albedo_type = albedo_type
1024        ENDDO       
1025
1026!
1027!--     Allocate indoor target temperature for summer and winter
1028        ALLOCATE ( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
1029        ALLOCATE ( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
1030        DO  l = 0, 3
1031           ALLOCATE ( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
1032           ALLOCATE ( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
1033        ENDDO
1034!
1035!--     In case the indoor model is applied, allocate memory for waste heat
1036!--     and indoor temperature.
1037        IF ( indoor_model )  THEN
1038           ALLOCATE ( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
1039           surf_usm_h%waste_heat = 0.0_wp
1040           DO  l = 0, 3
1041              ALLOCATE ( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
1042              surf_usm_v(l)%waste_heat = 0.0_wp
1043           ENDDO
1044        ENDIF
1045!
1046!--     Allocate flag indicating ground floor level surface elements
1047        ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) ) 
1048        DO  l = 0, 3
1049           ALLOCATE ( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
1050        ENDDO   
1051!
1052!--      Allocate arrays for relative surface fraction.
1053!--      0 - wall fraction, 1 - green fraction, 2 - window fraction
1054         ALLOCATE ( surf_usm_h%frac(0:2,1:surf_usm_h%ns) )
1055         surf_usm_h%frac = 0.0_wp
1056         DO  l = 0, 3
1057            ALLOCATE ( surf_usm_v(l)%frac(0:2,1:surf_usm_v(l)%ns) )
1058            surf_usm_v(l)%frac = 0.0_wp
1059         ENDDO
1060
1061!
1062!--     wall and roof surface parameters. First for horizontal surfaces
1063        ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)        )
1064        ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)        )
1065        ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
1066        ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns)  )
1067        ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)          )
1068        ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns)   )
1069        ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns)    )
1070        ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns)     )
1071        ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns)                )
1072        ALLOCATE ( surf_usm_h%emissivity(0:2,1:surf_usm_h%ns)     )
1073        ALLOCATE ( surf_usm_h%r_a(1:surf_usm_h%ns)                )
1074        ALLOCATE ( surf_usm_h%r_a_green(1:surf_usm_h%ns)          )
1075        ALLOCATE ( surf_usm_h%r_a_window(1:surf_usm_h%ns)         )
1076        ALLOCATE ( surf_usm_h%green_type_roof(1:surf_usm_h%ns)    )
1077        ALLOCATE ( surf_usm_h%r_s(1:surf_usm_h%ns)                )
1078       
1079!
1080!--     For vertical surfaces.
1081        DO  l = 0, 3
1082           ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)        )
1083           ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)          )
1084           ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
1085           ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns)   )
1086           ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns)  )
1087           ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns)    )
1088           ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns)     )
1089           ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns)                )
1090           ALLOCATE ( surf_usm_v(l)%emissivity(0:2,1:surf_usm_v(l)%ns)     )
1091           ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns)                )
1092           ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns)          )
1093           ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns)         )           
1094           ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns)                )
1095        ENDDO
1096
1097!       
1098!--     allocate wall and roof material parameters. First for horizontal surfaces
1099        ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)                    )
1100        ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
1101        ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns)                   )
1102        ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1103        ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns)      )
1104        ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1105        ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1106        ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1107        ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
1108
1109        ALLOCATE ( surf_usm_h%rho_c_total_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1110        ALLOCATE ( surf_usm_h%n_vg_green(1:surf_usm_h%ns)                             )
1111        ALLOCATE ( surf_usm_h%alpha_vg_green(1:surf_usm_h%ns)                         )
1112        ALLOCATE ( surf_usm_h%l_vg_green(1:surf_usm_h%ns)                             )
1113        ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1114        ALLOCATE ( surf_usm_h%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1115        ALLOCATE ( surf_usm_h%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1116        ALLOCATE ( surf_usm_h%tswc_h_m(nzb_wall:nzt_wall,1:surf_usm_h%ns)             )
1117
1118!
1119!--     For vertical surfaces.
1120        DO  l = 0, 3
1121           ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns)                    )
1122           ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns)                  )
1123           ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns)                   )
1124           ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1125           ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)      )
1126           ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1127           ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1128           ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1129           ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)     )
1130        ENDDO
1131
1132!
1133!--     allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
1134        ALLOCATE ( surf_usm_h%g_d(1:surf_usm_h%ns)              )
1135        ALLOCATE ( surf_usm_h%c_liq(1:surf_usm_h%ns)            )
1136        ALLOCATE ( surf_usm_h%qsws_liq(1:surf_usm_h%ns)         )
1137        ALLOCATE ( surf_usm_h%qsws_veg(1:surf_usm_h%ns)         )
1138        ALLOCATE ( surf_usm_h%r_canopy(1:surf_usm_h%ns)         )
1139        ALLOCATE ( surf_usm_h%r_canopy_min(1:surf_usm_h%ns)     )
1140        ALLOCATE ( surf_usm_h%qsws_eb(1:surf_usm_h%ns)          )
1141        ALLOCATE ( surf_usm_h%pt_10cm(1:surf_usm_h%ns)          ) 
1142        ALLOCATE ( surf_usm_h%pt_2m(1:surf_usm_h%ns)            ) 
1143
1144!
1145!--     For vertical surfaces.
1146        DO  l = 0, 3
1147          ALLOCATE ( surf_usm_v(l)%g_d(1:surf_usm_v(l)%ns)              )
1148          ALLOCATE ( surf_usm_v(l)%c_liq(1:surf_usm_v(l)%ns)            )
1149          ALLOCATE ( surf_usm_v(l)%qsws_liq(1:surf_usm_v(l)%ns)         )
1150          ALLOCATE ( surf_usm_v(l)%qsws_veg(1:surf_usm_v(l)%ns)         )
1151          ALLOCATE ( surf_usm_v(l)%qsws_eb(1:surf_usm_v(l)%ns)          )
1152          ALLOCATE ( surf_usm_v(l)%r_canopy(1:surf_usm_v(l)%ns)         )
1153          ALLOCATE ( surf_usm_v(l)%r_canopy_min(1:surf_usm_v(l)%ns)     )
1154          ALLOCATE ( surf_usm_v(l)%pt_10cm(1:surf_usm_v(l)%ns)          )
1155        ENDDO
1156
1157!
1158!--     allocate wall and roof layers sizes. For horizontal surfaces.
1159        ALLOCATE ( zwn(nzb_wall:nzt_wall)                                        )
1160        ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)       )
1161        ALLOCATE ( zwn_window(nzb_wall:nzt_wall)                                 )
1162        ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1163        ALLOCATE ( zwn_green(nzb_wall:nzt_wall)                                  )
1164        ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1165        ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1166        ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1167        ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1168        ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns)              )
1169        ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
1170        ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1171        ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1172        ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1173        ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1174        ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1175        ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1176        ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1177
1178!
1179!--     For vertical surfaces.
1180        DO  l = 0, 3
1181           ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)       )
1182           ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1183           ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1184           ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1185           ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1186           ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1187           ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)              )
1188           ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
1189           ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1190           ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1191           ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)       )
1192           ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1193           ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1194           ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1195           ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1196        ENDDO
1197
1198!
1199!--     allocate wall and roof temperature arrays, for horizontal walls
1200!
1201!--     Allocate if required. Note, in case of restarts, some of these arrays
1202!--     might be already allocated.
1203        IF ( .NOT. ALLOCATED( t_surf_wall_h_1 ) )                              &
1204           ALLOCATE ( t_surf_wall_h_1(1:surf_usm_h%ns) )
1205        IF ( .NOT. ALLOCATED( t_surf_wall_h_2 ) )                              &
1206           ALLOCATE ( t_surf_wall_h_2(1:surf_usm_h%ns) )
1207        IF ( .NOT. ALLOCATED( t_wall_h_1 ) )                                   &           
1208           ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1209        IF ( .NOT. ALLOCATED( t_wall_h_2 ) )                                   &           
1210           ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1211        IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) )                            &
1212           ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
1213        IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) )                            &
1214           ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
1215        IF ( .NOT. ALLOCATED( t_window_h_1 ) )                                 &           
1216           ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1217        IF ( .NOT. ALLOCATED( t_window_h_2 ) )                                 &           
1218           ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1219        IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) )                             &
1220           ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
1221        IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) )                             &
1222           ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
1223        IF ( .NOT. ALLOCATED( t_green_h_1 ) )                                  &           
1224           ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1225        IF ( .NOT. ALLOCATED( t_green_h_2 ) )                                  &           
1226           ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1227        IF ( .NOT. ALLOCATED( swc_h_1 ) )                                      &           
1228           ALLOCATE ( swc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1229        IF ( .NOT. ALLOCATED( swc_sat_h_1 ) )                                  &           
1230           ALLOCATE ( swc_sat_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1231        IF ( .NOT. ALLOCATED( swc_res_h_1 ) )                                  &           
1232           ALLOCATE ( swc_res_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1233        IF ( .NOT. ALLOCATED( swc_h_2 ) )                                      &           
1234           ALLOCATE ( swc_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1235        IF ( .NOT. ALLOCATED( rootfr_h_1 ) )                                   &           
1236           ALLOCATE ( rootfr_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1237        IF ( .NOT. ALLOCATED( wilt_h_1 ) )                                     &           
1238           ALLOCATE ( wilt_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1239        IF ( .NOT. ALLOCATED( fc_h_1 ) )                                       &           
1240           ALLOCATE ( fc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1241
1242        IF ( .NOT. ALLOCATED( m_liq_usm_h_1%var_usm_1d ) )                     &
1243           ALLOCATE ( m_liq_usm_h_1%var_usm_1d(1:surf_usm_h%ns) )
1244        IF ( .NOT. ALLOCATED( m_liq_usm_h_2%var_usm_1d ) )                     &
1245           ALLOCATE ( m_liq_usm_h_2%var_usm_1d(1:surf_usm_h%ns) )
1246           
1247!           
1248!--     initial assignment of the pointers
1249        t_wall_h    => t_wall_h_1;   t_wall_h_p   => t_wall_h_2
1250        t_window_h  => t_window_h_1; t_window_h_p => t_window_h_2
1251        t_green_h   => t_green_h_1;  t_green_h_p  => t_green_h_2
1252        t_surf_wall_h   => t_surf_wall_h_1;   t_surf_wall_h_p   => t_surf_wall_h_2           
1253        t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2 
1254        t_surf_green_h  => t_surf_green_h_1;  t_surf_green_h_p  => t_surf_green_h_2           
1255        m_liq_usm_h     => m_liq_usm_h_1;     m_liq_usm_h_p     => m_liq_usm_h_2
1256        swc_h     => swc_h_1; swc_h_p => swc_h_2
1257        swc_sat_h => swc_sat_h_1
1258        swc_res_h => swc_res_h_1
1259        rootfr_h  => rootfr_h_1
1260        wilt_h    => wilt_h_1
1261        fc_h      => fc_h_1
1262
1263!
1264!--     allocate wall and roof temperature arrays, for vertical walls if required
1265!
1266!--     Allocate if required. Note, in case of restarts, some of these arrays
1267!--     might be already allocated.
1268        DO  l = 0, 3
1269           IF ( .NOT. ALLOCATED( t_surf_wall_v_1(l)%t ) )                      &
1270              ALLOCATE ( t_surf_wall_v_1(l)%t(1:surf_usm_v(l)%ns) )
1271           IF ( .NOT. ALLOCATED( t_surf_wall_v_2(l)%t ) )                      &
1272              ALLOCATE ( t_surf_wall_v_2(l)%t(1:surf_usm_v(l)%ns) )
1273           IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) )                           &           
1274              ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1275           IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) )                           &           
1276              ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1277           IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) )                    &
1278              ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
1279           IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) )                    &
1280              ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
1281           IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                         &           
1282              ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1283           IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) )                         &           
1284              ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1285           IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) )                     &
1286              ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
1287           IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) )                     &
1288              ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
1289           IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                          &           
1290              ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1291           IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) )                          &           
1292              ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1293           IF ( .NOT. ALLOCATED( m_liq_usm_v_1(l)%var_usm_1d ) )               &
1294              ALLOCATE ( m_liq_usm_v_1(l)%var_usm_1d(1:surf_usm_v(l)%ns) )
1295           IF ( .NOT. ALLOCATED( m_liq_usm_v_2(l)%var_usm_1d ) )               &
1296              ALLOCATE ( m_liq_usm_v_2(l)%var_usm_1d(1:surf_usm_v(l)%ns) )
1297           IF ( .NOT. ALLOCATED( swc_v_1(l)%t ) )                              &           
1298              ALLOCATE ( swc_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1299           IF ( .NOT. ALLOCATED( swc_v_2(l)%t ) )                              &           
1300              ALLOCATE ( swc_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1301        ENDDO
1302!
1303!--     initial assignment of the pointers
1304        t_wall_v        => t_wall_v_1;        t_wall_v_p        => t_wall_v_2
1305        t_surf_wall_v   => t_surf_wall_v_1;   t_surf_wall_v_p   => t_surf_wall_v_2
1306        t_window_v      => t_window_v_1;      t_window_v_p      => t_window_v_2
1307        t_green_v       => t_green_v_1;       t_green_v_p       => t_green_v_2
1308        t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
1309        t_surf_green_v  => t_surf_green_v_1;  t_surf_green_v_p  => t_surf_green_v_2
1310        m_liq_usm_v     => m_liq_usm_v_1;     m_liq_usm_v_p     => m_liq_usm_v_2
1311        swc_v           => swc_v_1;           swc_v_p           => swc_v_2
1312
1313!
1314!--     Allocate intermediate timestep arrays. For horizontal surfaces.
1315        ALLOCATE ( surf_usm_h%tt_surface_wall_m(1:surf_usm_h%ns)               )
1316        ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)   )
1317        ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns)             )
1318        ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1319        ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1320        ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns)              )
1321
1322!
1323!--    Allocate intermediate timestep arrays
1324!--    Horizontal surfaces
1325       ALLOCATE ( tm_liq_usm_h_m%var_usm_1d(1:surf_usm_h%ns)                   )
1326!
1327!--    Horizontal surfaces
1328       DO  l = 0, 3
1329          ALLOCATE ( tm_liq_usm_v_m(l)%var_usm_1d(1:surf_usm_v(l)%ns)          )
1330       ENDDO 
1331       
1332!
1333!--     Set inital values for prognostic quantities
1334        IF ( ALLOCATED( surf_usm_h%tt_surface_wall_m )   )  surf_usm_h%tt_surface_wall_m   = 0.0_wp
1335        IF ( ALLOCATED( surf_usm_h%tt_wall_m )           )  surf_usm_h%tt_wall_m           = 0.0_wp
1336        IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) )  surf_usm_h%tt_surface_window_m = 0.0_wp
1337        IF ( ALLOCATED( surf_usm_h%tt_window_m    )      )  surf_usm_h%tt_window_m         = 0.0_wp
1338        IF ( ALLOCATED( surf_usm_h%tt_green_m    )       )  surf_usm_h%tt_green_m          = 0.0_wp
1339        IF ( ALLOCATED( surf_usm_h%tt_surface_green_m )  )  surf_usm_h%tt_surface_green_m  = 0.0_wp
1340!
1341!--     Now, for vertical surfaces
1342        DO  l = 0, 3
1343           ALLOCATE ( surf_usm_v(l)%tt_surface_wall_m(1:surf_usm_v(l)%ns)               )
1344           ALLOCATE ( surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)   )
1345           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_wall_m ) )  surf_usm_v(l)%tt_surface_wall_m = 0.0_wp
1346           IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m    ) )  surf_usm_v(l)%tt_wall_m    = 0.0_wp
1347           ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns)             )
1348           ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1349           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) )  surf_usm_v(l)%tt_surface_window_m = 0.0_wp
1350           IF ( ALLOCATED( surf_usm_v(l)%tt_window_m  ) )  surf_usm_v(l)%tt_window_m    = 0.0_wp
1351           ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns)              )
1352           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) )  surf_usm_v(l)%tt_surface_green_m = 0.0_wp
1353           ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)  )
1354           IF ( ALLOCATED( surf_usm_v(l)%tt_green_m   ) )  surf_usm_v(l)%tt_green_m    = 0.0_wp
1355        ENDDO
1356!
1357!--     allocate wall heat flux output array and set initial values. For horizontal surfaces
1358!        ALLOCATE ( surf_usm_h%wshf(1:surf_usm_h%ns)    )  !can be removed
1359        ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
1360        ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
1361        ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
1362        ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
1363        ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
1364        ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
1365        IF ( ALLOCATED( surf_usm_h%wshf    ) )  surf_usm_h%wshf    = 0.0_wp
1366        IF ( ALLOCATED( surf_usm_h%wshf_eb ) )  surf_usm_h%wshf_eb = 0.0_wp
1367        IF ( ALLOCATED( surf_usm_h%wghf_eb ) )  surf_usm_h%wghf_eb = 0.0_wp
1368        IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) )  surf_usm_h%wghf_eb_window = 0.0_wp
1369        IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) )  surf_usm_h%wghf_eb_green = 0.0_wp
1370        IF ( ALLOCATED( surf_usm_h%iwghf_eb ) )  surf_usm_h%iwghf_eb = 0.0_wp
1371        IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) )  surf_usm_h%iwghf_eb_window = 0.0_wp
1372!
1373!--     Now, for vertical surfaces
1374        DO  l = 0, 3
1375!           ALLOCATE ( surf_usm_v(l)%wshf(1:surf_usm_v(l)%ns)    )    ! can be removed
1376           ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
1377           ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
1378           ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
1379           ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
1380           ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
1381           ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
1382           IF ( ALLOCATED( surf_usm_v(l)%wshf    ) )  surf_usm_v(l)%wshf    = 0.0_wp
1383           IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) )  surf_usm_v(l)%wshf_eb = 0.0_wp
1384           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) )  surf_usm_v(l)%wghf_eb = 0.0_wp
1385           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) )  surf_usm_v(l)%wghf_eb_window = 0.0_wp
1386           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) )  surf_usm_v(l)%wghf_eb_green = 0.0_wp
1387           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) )  surf_usm_v(l)%iwghf_eb = 0.0_wp
1388           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) )  surf_usm_v(l)%iwghf_eb_window = 0.0_wp
1389        ENDDO
1390
1391        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'end' )
1392       
1393    END SUBROUTINE usm_init_arrays
1394
1395
1396!------------------------------------------------------------------------------!
1397! Description:
1398! ------------
1399!> Sum up and time-average urban surface output quantities as well as allocate
1400!> the array necessary for storing the average.
1401!------------------------------------------------------------------------------!
1402    SUBROUTINE usm_3d_data_averaging( mode, variable )
1403
1404        IMPLICIT NONE
1405
1406        CHARACTER(LEN=*), INTENT(IN) ::  mode
1407        CHARACTER(LEN=*), INTENT(IN) :: variable
1408 
1409        INTEGER(iwp)                                       :: i, j, k, l, m, ids, idsint, iwl, istat  !< runnin indices
1410        CHARACTER(LEN=varnamelength)                       :: var                                     !< trimmed variable
1411        INTEGER(iwp), PARAMETER                            :: nd = 5                                  !< number of directions
1412        CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
1413        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
1414
1415        IF ( variable(1:4) == 'usm_' )  THEN  ! is such a check really rquired?
1416
1417!
1418!--     find the real name of the variable
1419        ids = -1
1420        l = -1
1421        var = TRIM(variable)
1422        DO i = 0, nd-1
1423            k = len(TRIM(var))
1424            j = len(TRIM(dirname(i)))
1425            IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
1426                ids = i
1427                idsint = dirint(ids)
1428                var = var(:k-j)
1429                EXIT
1430            ENDIF
1431        ENDDO
1432        l = idsint - 2  ! horisontal direction index - terible hack !
1433        IF ( l < 0 .OR. l > 3 ) THEN
1434           l = -1
1435        END IF
1436        IF ( ids == -1 )  THEN
1437            var = TRIM(variable)
1438        ENDIF
1439        IF ( var(1:11) == 'usm_t_wall_'  .AND.  len(TRIM(var)) >= 12 )  THEN
1440!
1441!--          wall layers
1442            READ(var(12:12), '(I1)', iostat=istat ) iwl
1443            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1444                var = var(1:10)
1445            ELSE
1446!
1447!--             wrong wall layer index
1448                RETURN
1449            ENDIF
1450        ENDIF
1451        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
1452!
1453!--          wall layers
1454            READ(var(14:14), '(I1)', iostat=istat ) iwl
1455            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1456                var = var(1:12)
1457            ELSE
1458!
1459!--             wrong window layer index
1460                RETURN
1461            ENDIF
1462        ENDIF
1463        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
1464!
1465!--          wall layers
1466            READ(var(13:13), '(I1)', iostat=istat ) iwl
1467            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1468                var = var(1:11)
1469            ELSE
1470!
1471!--             wrong green layer index
1472                RETURN
1473            ENDIF
1474        ENDIF
1475        IF ( var(1:8) == 'usm_swc_'  .AND.  len(TRIM(var)) >= 9 )  THEN
1476!
1477!--          swc layers
1478            READ(var(9:9), '(I1)', iostat=istat ) iwl
1479            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1480                var = var(1:7)
1481            ELSE
1482!
1483!--             wrong swc layer index
1484                RETURN
1485            ENDIF
1486        ENDIF
1487
1488        IF ( mode == 'allocate' )  THEN
1489           
1490           SELECT CASE ( TRIM( var ) )
1491
1492                CASE ( 'usm_wshf' )
1493!
1494!--                 array of sensible heat flux from surfaces
1495!--                 land surfaces
1496                    IF ( l == -1 ) THEN
1497                       IF ( .NOT.  ALLOCATED(surf_usm_h%wshf_eb_av) )  THEN
1498                          ALLOCATE ( surf_usm_h%wshf_eb_av(1:surf_usm_h%ns) )
1499                          surf_usm_h%wshf_eb_av = 0.0_wp
1500                       ENDIF
1501                    ELSE
1502                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wshf_eb_av) )  THEN
1503                           ALLOCATE ( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) )
1504                           surf_usm_v(l)%wshf_eb_av = 0.0_wp
1505                       ENDIF
1506                    ENDIF
1507                   
1508                CASE ( 'usm_qsws' )
1509!
1510!--                 array of latent heat flux from surfaces
1511!--                 land surfaces
1512                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_eb_av) )  THEN
1513                        ALLOCATE ( surf_usm_h%qsws_eb_av(1:surf_usm_h%ns) )
1514                        surf_usm_h%qsws_eb_av = 0.0_wp
1515                    ELSE
1516                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_eb_av) )  THEN
1517                           ALLOCATE ( surf_usm_v(l)%qsws_eb_av(1:surf_usm_v(l)%ns) )
1518                           surf_usm_v(l)%qsws_eb_av = 0.0_wp
1519                       ENDIF
1520                    ENDIF
1521                   
1522                CASE ( 'usm_qsws_veg' )
1523!
1524!--                 array of latent heat flux from vegetation surfaces
1525!--                 land surfaces
1526                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_veg_av) )  THEN
1527                        ALLOCATE ( surf_usm_h%qsws_veg_av(1:surf_usm_h%ns) )
1528                        surf_usm_h%qsws_veg_av = 0.0_wp
1529                    ELSE
1530                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_veg_av) )  THEN
1531                           ALLOCATE ( surf_usm_v(l)%qsws_veg_av(1:surf_usm_v(l)%ns) )
1532                           surf_usm_v(l)%qsws_veg_av = 0.0_wp
1533                       ENDIF
1534                    ENDIF
1535                   
1536                CASE ( 'usm_qsws_liq' )
1537!
1538!--                 array of latent heat flux from surfaces with liquid
1539!--                 land surfaces
1540                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_liq_av) )  THEN
1541                        ALLOCATE ( surf_usm_h%qsws_liq_av(1:surf_usm_h%ns) )
1542                        surf_usm_h%qsws_liq_av = 0.0_wp
1543                    ELSE
1544                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_liq_av) )  THEN
1545                           ALLOCATE ( surf_usm_v(l)%qsws_liq_av(1:surf_usm_v(l)%ns) )
1546                           surf_usm_v(l)%qsws_liq_av = 0.0_wp
1547                       ENDIF
1548                    ENDIF
1549!
1550!--             Please note, the following output quantities belongs to the
1551!--             individual tile fractions - ground heat flux at wall-, window-,
1552!--             and green fraction. Aggregated ground-heat flux is treated
1553!--             accordingly in average_3d_data, sum_up_3d_data, etc..
1554                CASE ( 'usm_wghf' )
1555!
1556!--                 array of heat flux from ground (wall, roof, land)
1557                    IF ( l == -1 ) THEN
1558                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_av) )  THEN
1559                           ALLOCATE ( surf_usm_h%wghf_eb_av(1:surf_usm_h%ns) )
1560                           surf_usm_h%wghf_eb_av = 0.0_wp
1561                       ENDIF
1562                    ELSE
1563                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_av) )  THEN
1564                           ALLOCATE ( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) )
1565                           surf_usm_v(l)%wghf_eb_av = 0.0_wp
1566                       ENDIF
1567                    ENDIF
1568
1569                CASE ( 'usm_wghf_window' )
1570!
1571!--                 array of heat flux from window ground (wall, roof, land)
1572                    IF ( l == -1 ) THEN
1573                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_window_av) )  THEN
1574                           ALLOCATE ( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
1575                           surf_usm_h%wghf_eb_window_av = 0.0_wp
1576                       ENDIF
1577                    ELSE
1578                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_window_av) )  THEN
1579                           ALLOCATE ( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
1580                           surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
1581                       ENDIF
1582                    ENDIF
1583
1584                CASE ( 'usm_wghf_green' )
1585!
1586!--                 array of heat flux from green ground (wall, roof, land)
1587                    IF ( l == -1 ) THEN
1588                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_green_av) )  THEN
1589                           ALLOCATE ( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
1590                           surf_usm_h%wghf_eb_green_av = 0.0_wp
1591                       ENDIF
1592                    ELSE
1593                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_green_av) )  THEN
1594                           ALLOCATE ( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
1595                           surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
1596                       ENDIF
1597                    ENDIF
1598
1599                CASE ( 'usm_iwghf' )
1600!
1601!--                 array of heat flux from indoor ground (wall, roof, land)
1602                    IF ( l == -1 ) THEN
1603                       IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_av) )  THEN
1604                           ALLOCATE ( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
1605                           surf_usm_h%iwghf_eb_av = 0.0_wp
1606                       ENDIF
1607                    ELSE
1608                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_av) )  THEN
1609                           ALLOCATE ( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
1610                           surf_usm_v(l)%iwghf_eb_av = 0.0_wp
1611                       ENDIF
1612                    ENDIF
1613
1614                CASE ( 'usm_iwghf_window' )
1615!
1616!--                 array of heat flux from indoor window ground (wall, roof, land)
1617                    IF ( l == -1 ) THEN
1618                       IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_window_av) )  THEN
1619                           ALLOCATE ( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
1620                           surf_usm_h%iwghf_eb_window_av = 0.0_wp
1621                       ENDIF
1622                    ELSE
1623                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_window_av) )  THEN
1624                           ALLOCATE ( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
1625                           surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
1626                       ENDIF
1627                    ENDIF
1628
1629                CASE ( 'usm_t_surf_wall' )
1630!
1631!--                 surface temperature for surfaces
1632                    IF ( l == -1 ) THEN
1633                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_wall_av) )  THEN
1634                           ALLOCATE ( surf_usm_h%t_surf_wall_av(1:surf_usm_h%ns) )
1635                           surf_usm_h%t_surf_wall_av = 0.0_wp
1636                       ENDIF
1637                    ELSE
1638                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_wall_av) )  THEN
1639                           ALLOCATE ( surf_usm_v(l)%t_surf_wall_av(1:surf_usm_v(l)%ns) )
1640                           surf_usm_v(l)%t_surf_wall_av = 0.0_wp
1641                       ENDIF
1642                    ENDIF
1643
1644                CASE ( 'usm_t_surf_window' )
1645!
1646!--                 surface temperature for window surfaces
1647                    IF ( l == -1 ) THEN
1648                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_window_av) )  THEN
1649                           ALLOCATE ( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
1650                           surf_usm_h%t_surf_window_av = 0.0_wp
1651                       ENDIF
1652                    ELSE
1653                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_window_av) )  THEN
1654                           ALLOCATE ( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
1655                           surf_usm_v(l)%t_surf_window_av = 0.0_wp
1656                       ENDIF
1657                    ENDIF
1658                   
1659                CASE ( 'usm_t_surf_green' )
1660!
1661!--                 surface temperature for green surfaces
1662                    IF ( l == -1 ) THEN
1663                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_green_av) )  THEN
1664                           ALLOCATE ( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
1665                           surf_usm_h%t_surf_green_av = 0.0_wp
1666                       ENDIF
1667                    ELSE
1668                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_green_av) )  THEN
1669                           ALLOCATE ( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
1670                           surf_usm_v(l)%t_surf_green_av = 0.0_wp
1671                       ENDIF
1672                    ENDIF
1673               
1674                CASE ( 'usm_theta_10cm' )
1675!
1676!--                 near surface (10cm) temperature for whole surfaces
1677                    IF ( l == -1 ) THEN
1678                       IF ( .NOT.  ALLOCATED(surf_usm_h%pt_10cm_av) )  THEN
1679                           ALLOCATE ( surf_usm_h%pt_10cm_av(1:surf_usm_h%ns) )
1680                           surf_usm_h%pt_10cm_av = 0.0_wp
1681                       ENDIF
1682                    ELSE
1683                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%pt_10cm_av) )  THEN
1684                           ALLOCATE ( surf_usm_v(l)%pt_10cm_av(1:surf_usm_v(l)%ns) )
1685                           surf_usm_v(l)%pt_10cm_av = 0.0_wp
1686                       ENDIF
1687                    ENDIF
1688                 
1689                CASE ( 'usm_t_wall' )
1690!
1691!--                 wall temperature for iwl layer of walls and land
1692                    IF ( l == -1 ) THEN
1693                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_wall_av) )  THEN
1694                           ALLOCATE ( surf_usm_h%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1695                           surf_usm_h%t_wall_av = 0.0_wp
1696                       ENDIF
1697                    ELSE
1698                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_wall_av) )  THEN
1699                           ALLOCATE ( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1700                           surf_usm_v(l)%t_wall_av = 0.0_wp
1701                       ENDIF
1702                    ENDIF
1703
1704                CASE ( 'usm_t_window' )
1705!
1706!--                 window temperature for iwl layer of walls and land
1707                    IF ( l == -1 ) THEN
1708                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_window_av) )  THEN
1709                           ALLOCATE ( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1710                           surf_usm_h%t_window_av = 0.0_wp
1711                       ENDIF
1712                    ELSE
1713                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_window_av) )  THEN
1714                           ALLOCATE ( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1715                           surf_usm_v(l)%t_window_av = 0.0_wp
1716                       ENDIF
1717                    ENDIF
1718
1719                CASE ( 'usm_t_green' )
1720!
1721!--                 green temperature for iwl layer of walls and land
1722                    IF ( l == -1 ) THEN
1723                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_green_av) )  THEN
1724                           ALLOCATE ( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1725                           surf_usm_h%t_green_av = 0.0_wp
1726                       ENDIF
1727                    ELSE
1728                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_green_av) )  THEN
1729                           ALLOCATE ( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1730                           surf_usm_v(l)%t_green_av = 0.0_wp
1731                       ENDIF
1732                    ENDIF
1733                CASE ( 'usm_swc' )
1734!
1735!--                 soil water content for iwl layer of walls and land
1736                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%swc_av) )  THEN
1737                        ALLOCATE ( surf_usm_h%swc_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1738                        surf_usm_h%swc_av = 0.0_wp
1739                    ELSE
1740                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%swc_av) )  THEN
1741                           ALLOCATE ( surf_usm_v(l)%swc_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1742                           surf_usm_v(l)%swc_av = 0.0_wp
1743                       ENDIF
1744                    ENDIF
1745
1746               CASE DEFAULT
1747                   CONTINUE
1748
1749           END SELECT
1750
1751        ELSEIF ( mode == 'sum' )  THEN
1752           
1753           SELECT CASE ( TRIM( var ) )
1754
1755                CASE ( 'usm_wshf' )
1756!
1757!--                 array of sensible heat flux from surfaces (land, roof, wall)
1758                    IF ( l == -1 ) THEN
1759                       DO  m = 1, surf_usm_h%ns
1760                          surf_usm_h%wshf_eb_av(m) =                              &
1761                                             surf_usm_h%wshf_eb_av(m) +           &
1762                                             surf_usm_h%wshf_eb(m)
1763                       ENDDO
1764                    ELSE
1765                       DO  m = 1, surf_usm_v(l)%ns
1766                          surf_usm_v(l)%wshf_eb_av(m) =                        &
1767                                          surf_usm_v(l)%wshf_eb_av(m) +        &
1768                                          surf_usm_v(l)%wshf_eb(m)
1769                       ENDDO
1770                    ENDIF
1771                   
1772                CASE ( 'usm_qsws' )
1773!
1774!--                 array of latent heat flux from surfaces (land, roof, wall)
1775                    IF ( l == -1 ) THEN
1776                    DO  m = 1, surf_usm_h%ns
1777                       surf_usm_h%qsws_eb_av(m) =                              &
1778                                          surf_usm_h%qsws_eb_av(m) +           &
1779                                          surf_usm_h%qsws_eb(m)
1780                    ENDDO
1781                    ELSE
1782                       DO  m = 1, surf_usm_v(l)%ns
1783                          surf_usm_v(l)%qsws_eb_av(m) =                        &
1784                                          surf_usm_v(l)%qsws_eb_av(m) +        &
1785                                          surf_usm_v(l)%qsws_eb(m)
1786                       ENDDO
1787                    ENDIF
1788                   
1789                CASE ( 'usm_qsws_veg' )
1790!
1791!--                 array of latent heat flux from vegetation surfaces (land, roof, wall)
1792                    IF ( l == -1 ) THEN
1793                    DO  m = 1, surf_usm_h%ns
1794                       surf_usm_h%qsws_veg_av(m) =                              &
1795                                          surf_usm_h%qsws_veg_av(m) +           &
1796                                          surf_usm_h%qsws_veg(m)
1797                    ENDDO
1798                    ELSE
1799                       DO  m = 1, surf_usm_v(l)%ns
1800                          surf_usm_v(l)%qsws_veg_av(m) =                        &
1801                                          surf_usm_v(l)%qsws_veg_av(m) +        &
1802                                          surf_usm_v(l)%qsws_veg(m)
1803                       ENDDO
1804                    ENDIF
1805                   
1806                CASE ( 'usm_qsws_liq' )
1807!
1808!--                 array of latent heat flux from surfaces with liquid (land, roof, wall)
1809                    IF ( l == -1 ) THEN
1810                    DO  m = 1, surf_usm_h%ns
1811                       surf_usm_h%qsws_liq_av(m) =                              &
1812                                          surf_usm_h%qsws_liq_av(m) +           &
1813                                          surf_usm_h%qsws_liq(m)
1814                    ENDDO
1815                    ELSE
1816                       DO  m = 1, surf_usm_v(l)%ns
1817                          surf_usm_v(l)%qsws_liq_av(m) =                        &
1818                                          surf_usm_v(l)%qsws_liq_av(m) +        &
1819                                          surf_usm_v(l)%qsws_liq(m)
1820                       ENDDO
1821                    ENDIF
1822                   
1823                CASE ( 'usm_wghf' )
1824!
1825!--                 array of heat flux from ground (wall, roof, land)
1826                    IF ( l == -1 ) THEN
1827                       DO  m = 1, surf_usm_h%ns
1828                          surf_usm_h%wghf_eb_av(m) =                              &
1829                                             surf_usm_h%wghf_eb_av(m) +           &
1830                                             surf_usm_h%wghf_eb(m)
1831                       ENDDO
1832                    ELSE
1833                       DO  m = 1, surf_usm_v(l)%ns
1834                          surf_usm_v(l)%wghf_eb_av(m) =                        &
1835                                          surf_usm_v(l)%wghf_eb_av(m) +        &
1836                                          surf_usm_v(l)%wghf_eb(m)
1837                       ENDDO
1838                    ENDIF
1839                   
1840                CASE ( 'usm_wghf_window' )
1841!
1842!--                 array of heat flux from window ground (wall, roof, land)
1843                    IF ( l == -1 ) THEN
1844                       DO  m = 1, surf_usm_h%ns
1845                          surf_usm_h%wghf_eb_window_av(m) =                              &
1846                                             surf_usm_h%wghf_eb_window_av(m) +           &
1847                                             surf_usm_h%wghf_eb_window(m)
1848                       ENDDO
1849                    ELSE
1850                       DO  m = 1, surf_usm_v(l)%ns
1851                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
1852                                          surf_usm_v(l)%wghf_eb_window_av(m) +        &
1853                                          surf_usm_v(l)%wghf_eb_window(m)
1854                       ENDDO
1855                    ENDIF
1856
1857                CASE ( 'usm_wghf_green' )
1858!
1859!--                 array of heat flux from green ground (wall, roof, land)
1860                    IF ( l == -1 ) THEN
1861                       DO  m = 1, surf_usm_h%ns
1862                          surf_usm_h%wghf_eb_green_av(m) =                              &
1863                                             surf_usm_h%wghf_eb_green_av(m) +           &
1864                                             surf_usm_h%wghf_eb_green(m)
1865                       ENDDO
1866                    ELSE
1867                       DO  m = 1, surf_usm_v(l)%ns
1868                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
1869                                          surf_usm_v(l)%wghf_eb_green_av(m) +        &
1870                                          surf_usm_v(l)%wghf_eb_green(m)
1871                       ENDDO
1872                    ENDIF
1873                   
1874                CASE ( 'usm_iwghf' )
1875!
1876!--                 array of heat flux from indoor ground (wall, roof, land)
1877                    IF ( l == -1 ) THEN
1878                       DO  m = 1, surf_usm_h%ns
1879                          surf_usm_h%iwghf_eb_av(m) =                              &
1880                                             surf_usm_h%iwghf_eb_av(m) +           &
1881                                             surf_usm_h%iwghf_eb(m)
1882                       ENDDO
1883                    ELSE
1884                       DO  m = 1, surf_usm_v(l)%ns
1885                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
1886                                          surf_usm_v(l)%iwghf_eb_av(m) +        &
1887                                          surf_usm_v(l)%iwghf_eb(m)
1888                       ENDDO
1889                    ENDIF
1890                   
1891                CASE ( 'usm_iwghf_window' )
1892!
1893!--                 array of heat flux from indoor window ground (wall, roof, land)
1894                    IF ( l == -1 ) THEN
1895                       DO  m = 1, surf_usm_h%ns
1896                          surf_usm_h%iwghf_eb_window_av(m) =                              &
1897                                             surf_usm_h%iwghf_eb_window_av(m) +           &
1898                                             surf_usm_h%iwghf_eb_window(m)
1899                       ENDDO
1900                    ELSE
1901                       DO  m = 1, surf_usm_v(l)%ns
1902                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
1903                                          surf_usm_v(l)%iwghf_eb_window_av(m) +        &
1904                                          surf_usm_v(l)%iwghf_eb_window(m)
1905                       ENDDO
1906                    ENDIF
1907                   
1908                CASE ( 'usm_t_surf_wall' )
1909!
1910!--                 surface temperature for surfaces
1911                    IF ( l == -1 ) THEN
1912                       DO  m = 1, surf_usm_h%ns
1913                       surf_usm_h%t_surf_wall_av(m) =                               & 
1914                                          surf_usm_h%t_surf_wall_av(m) +            &
1915                                          t_surf_wall_h(m)
1916                       ENDDO
1917                    ELSE
1918                       DO  m = 1, surf_usm_v(l)%ns
1919                          surf_usm_v(l)%t_surf_wall_av(m) =                         &
1920                                          surf_usm_v(l)%t_surf_wall_av(m) +         &
1921                                          t_surf_wall_v(l)%t(m)
1922                       ENDDO
1923                    ENDIF
1924                   
1925                CASE ( 'usm_t_surf_window' )
1926!
1927!--                 surface temperature for window surfaces
1928                    IF ( l == -1 ) THEN
1929                       DO  m = 1, surf_usm_h%ns
1930                          surf_usm_h%t_surf_window_av(m) =                               &
1931                                             surf_usm_h%t_surf_window_av(m) +            &
1932                                             t_surf_window_h(m)
1933                       ENDDO
1934                    ELSE
1935                       DO  m = 1, surf_usm_v(l)%ns
1936                          surf_usm_v(l)%t_surf_window_av(m) =                         &
1937                                          surf_usm_v(l)%t_surf_window_av(m) +         &
1938                                          t_surf_window_v(l)%t(m)
1939                       ENDDO
1940                    ENDIF
1941                   
1942                CASE ( 'usm_t_surf_green' )
1943!
1944!--                 surface temperature for green surfaces
1945                    IF ( l == -1 ) THEN
1946                       DO  m = 1, surf_usm_h%ns
1947                          surf_usm_h%t_surf_green_av(m) =                               &
1948                                             surf_usm_h%t_surf_green_av(m) +            &
1949                                             t_surf_green_h(m)
1950                       ENDDO
1951                    ELSE
1952                       DO  m = 1, surf_usm_v(l)%ns
1953                          surf_usm_v(l)%t_surf_green_av(m) =                         &
1954                                          surf_usm_v(l)%t_surf_green_av(m) +         &
1955                                          t_surf_green_v(l)%t(m)
1956                       ENDDO
1957                    ENDIF
1958               
1959                CASE ( 'usm_theta_10cm' )
1960!
1961!--                 near surface temperature for whole surfaces
1962                    IF ( l == -1 ) THEN
1963                       DO  m = 1, surf_usm_h%ns
1964                          surf_usm_h%pt_10cm_av(m) =                               &
1965                                             surf_usm_h%pt_10cm_av(m) +            &
1966                                             surf_usm_h%pt_10cm(m)
1967                       ENDDO
1968                    ELSE
1969                       DO  m = 1, surf_usm_v(l)%ns
1970                          surf_usm_v(l)%pt_10cm_av(m) =                         &
1971                                          surf_usm_v(l)%pt_10cm_av(m) +         &
1972                                          surf_usm_v(l)%pt_10cm(m)
1973                       ENDDO
1974                    ENDIF
1975                   
1976                CASE ( 'usm_t_wall' )
1977!
1978!--                 wall temperature for  iwl layer of walls and land
1979                    IF ( l == -1 ) THEN
1980                       DO  m = 1, surf_usm_h%ns
1981                          surf_usm_h%t_wall_av(iwl,m) =                           &
1982                                             surf_usm_h%t_wall_av(iwl,m) +        &
1983                                             t_wall_h(iwl,m)
1984                       ENDDO
1985                    ELSE
1986                       DO  m = 1, surf_usm_v(l)%ns
1987                          surf_usm_v(l)%t_wall_av(iwl,m) =                     &
1988                                          surf_usm_v(l)%t_wall_av(iwl,m) +     &
1989                                          t_wall_v(l)%t(iwl,m)
1990                       ENDDO
1991                    ENDIF
1992                   
1993                CASE ( 'usm_t_window' )
1994!
1995!--                 window temperature for  iwl layer of walls and land
1996                    IF ( l == -1 ) THEN
1997                       DO  m = 1, surf_usm_h%ns
1998                          surf_usm_h%t_window_av(iwl,m) =                           &
1999                                             surf_usm_h%t_window_av(iwl,m) +        &
2000                                             t_window_h(iwl,m)
2001                       ENDDO
2002                    ELSE
2003                       DO  m = 1, surf_usm_v(l)%ns
2004                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
2005                                          surf_usm_v(l)%t_window_av(iwl,m) +     &
2006                                          t_window_v(l)%t(iwl,m)
2007                       ENDDO
2008                    ENDIF
2009
2010                CASE ( 'usm_t_green' )
2011!
2012!--                 green temperature for  iwl layer of walls and land
2013                    IF ( l == -1 ) THEN
2014                       DO  m = 1, surf_usm_h%ns
2015                          surf_usm_h%t_green_av(iwl,m) =                           &
2016                                             surf_usm_h%t_green_av(iwl,m) +        &
2017                                             t_green_h(iwl,m)
2018                       ENDDO
2019                    ELSE
2020                       DO  m = 1, surf_usm_v(l)%ns
2021                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
2022                                          surf_usm_v(l)%t_green_av(iwl,m) +     &
2023                                          t_green_v(l)%t(iwl,m)
2024                       ENDDO
2025                    ENDIF
2026
2027                CASE ( 'usm_swc' )
2028!
2029!--                 soil water content for  iwl layer of walls and land
2030                    IF ( l == -1 ) THEN
2031                    DO  m = 1, surf_usm_h%ns
2032                       surf_usm_h%swc_av(iwl,m) =                           &
2033                                          surf_usm_h%swc_av(iwl,m) +        &
2034                                          swc_h(iwl,m)
2035                    ENDDO
2036                    ELSE
2037                       DO  m = 1, surf_usm_v(l)%ns
2038                          surf_usm_v(l)%swc_av(iwl,m) =                     &
2039                                          surf_usm_v(l)%swc_av(iwl,m) +     &
2040                                          swc_v(l)%t(iwl,m)
2041                       ENDDO
2042                    ENDIF
2043
2044                CASE DEFAULT
2045                    CONTINUE
2046
2047           END SELECT
2048
2049        ELSEIF ( mode == 'average' )  THEN
2050           
2051           SELECT CASE ( TRIM( var ) )
2052
2053                CASE ( 'usm_wshf' )
2054!
2055!--                 array of sensible heat flux from surfaces (land, roof, wall)
2056                    IF ( l == -1 ) THEN
2057                       DO  m = 1, surf_usm_h%ns
2058                          surf_usm_h%wshf_eb_av(m) =                              &
2059                                             surf_usm_h%wshf_eb_av(m) /           &
2060                                             REAL( average_count_3d, kind=wp )
2061                       ENDDO
2062                    ELSE
2063                       DO  m = 1, surf_usm_v(l)%ns
2064                          surf_usm_v(l)%wshf_eb_av(m) =                        &
2065                                          surf_usm_v(l)%wshf_eb_av(m) /        &
2066                                          REAL( average_count_3d, kind=wp )
2067                       ENDDO
2068                    ENDIF
2069                   
2070                CASE ( 'usm_qsws' )
2071!
2072!--                 array of latent heat flux from surfaces (land, roof, wall)
2073                    IF ( l == -1 ) THEN
2074                    DO  m = 1, surf_usm_h%ns
2075                       surf_usm_h%qsws_eb_av(m) =                              &
2076                                          surf_usm_h%qsws_eb_av(m) /           &
2077                                          REAL( average_count_3d, kind=wp )
2078                    ENDDO
2079                    ELSE
2080                       DO  m = 1, surf_usm_v(l)%ns
2081                          surf_usm_v(l)%qsws_eb_av(m) =                        &
2082                                          surf_usm_v(l)%qsws_eb_av(m) /        &
2083                                          REAL( average_count_3d, kind=wp )
2084                       ENDDO
2085                    ENDIF
2086
2087                CASE ( 'usm_qsws_veg' )
2088!
2089!--                 array of latent heat flux from vegetation surfaces (land, roof, wall)
2090                    IF ( l == -1 ) THEN
2091                    DO  m = 1, surf_usm_h%ns
2092                       surf_usm_h%qsws_veg_av(m) =                              &
2093                                          surf_usm_h%qsws_veg_av(m) /           &
2094                                          REAL( average_count_3d, kind=wp )
2095                    ENDDO
2096                    ELSE
2097                       DO  m = 1, surf_usm_v(l)%ns
2098                          surf_usm_v(l)%qsws_veg_av(m) =                        &
2099                                          surf_usm_v(l)%qsws_veg_av(m) /        &
2100                                          REAL( average_count_3d, kind=wp )
2101                       ENDDO
2102                    ENDIF
2103                   
2104                CASE ( 'usm_qsws_liq' )
2105!
2106!--                 array of latent heat flux from surfaces with liquid (land, roof, wall)
2107                    IF ( l == -1 ) THEN
2108                    DO  m = 1, surf_usm_h%ns
2109                       surf_usm_h%qsws_liq_av(m) =                              &
2110                                          surf_usm_h%qsws_liq_av(m) /           &
2111                                          REAL( average_count_3d, kind=wp )
2112                    ENDDO
2113                    ELSE
2114                       DO  m = 1, surf_usm_v(l)%ns
2115                          surf_usm_v(l)%qsws_liq_av(m) =                        &
2116                                          surf_usm_v(l)%qsws_liq_av(m) /        &
2117                                          REAL( average_count_3d, kind=wp )
2118                       ENDDO
2119                    ENDIF
2120                   
2121                CASE ( 'usm_wghf' )
2122!
2123!--                 array of heat flux from ground (wall, roof, land)
2124                    IF ( l == -1 ) THEN
2125                       DO  m = 1, surf_usm_h%ns
2126                          surf_usm_h%wghf_eb_av(m) =                              &
2127                                             surf_usm_h%wghf_eb_av(m) /           &
2128                                             REAL( average_count_3d, kind=wp )
2129                       ENDDO
2130                    ELSE
2131                       DO  m = 1, surf_usm_v(l)%ns
2132                          surf_usm_v(l)%wghf_eb_av(m) =                        &
2133                                          surf_usm_v(l)%wghf_eb_av(m) /        &
2134                                          REAL( average_count_3d, kind=wp )
2135                       ENDDO
2136                    ENDIF
2137                   
2138                CASE ( 'usm_wghf_window' )
2139!
2140!--                 array of heat flux from window ground (wall, roof, land)
2141                    IF ( l == -1 ) THEN
2142                       DO  m = 1, surf_usm_h%ns
2143                          surf_usm_h%wghf_eb_window_av(m) =                              &
2144                                             surf_usm_h%wghf_eb_window_av(m) /           &
2145                                             REAL( average_count_3d, kind=wp )
2146                       ENDDO
2147                    ELSE
2148                       DO  m = 1, surf_usm_v(l)%ns
2149                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
2150                                          surf_usm_v(l)%wghf_eb_window_av(m) /        &
2151                                          REAL( average_count_3d, kind=wp )
2152                       ENDDO
2153                    ENDIF
2154
2155                CASE ( 'usm_wghf_green' )
2156!
2157!--                 array of heat flux from green ground (wall, roof, land)
2158                    IF ( l == -1 ) THEN
2159                       DO  m = 1, surf_usm_h%ns
2160                          surf_usm_h%wghf_eb_green_av(m) =                              &
2161                                             surf_usm_h%wghf_eb_green_av(m) /           &
2162                                             REAL( average_count_3d, kind=wp )
2163                       ENDDO
2164                    ELSE
2165                       DO  m = 1, surf_usm_v(l)%ns
2166                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
2167                                          surf_usm_v(l)%wghf_eb_green_av(m) /        &
2168                                          REAL( average_count_3d, kind=wp )
2169                       ENDDO
2170                    ENDIF
2171
2172                CASE ( 'usm_iwghf' )
2173!
2174!--                 array of heat flux from indoor ground (wall, roof, land)
2175                    IF ( l == -1 ) THEN
2176                       DO  m = 1, surf_usm_h%ns
2177                          surf_usm_h%iwghf_eb_av(m) =                              &
2178                                             surf_usm_h%iwghf_eb_av(m) /           &
2179                                             REAL( average_count_3d, kind=wp )
2180                       ENDDO
2181                    ELSE
2182                       DO  m = 1, surf_usm_v(l)%ns
2183                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
2184                                          surf_usm_v(l)%iwghf_eb_av(m) /        &
2185                                          REAL( average_count_3d, kind=wp )
2186                       ENDDO
2187                    ENDIF
2188                   
2189                CASE ( 'usm_iwghf_window' )
2190!
2191!--                 array of heat flux from indoor window ground (wall, roof, land)
2192                    IF ( l == -1 ) THEN
2193                       DO  m = 1, surf_usm_h%ns
2194                          surf_usm_h%iwghf_eb_window_av(m) =                              &
2195                                             surf_usm_h%iwghf_eb_window_av(m) /           &
2196                                             REAL( average_count_3d, kind=wp )
2197                       ENDDO
2198                    ELSE
2199                       DO  m = 1, surf_usm_v(l)%ns
2200                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
2201                                          surf_usm_v(l)%iwghf_eb_window_av(m) /        &
2202                                          REAL( average_count_3d, kind=wp )
2203                       ENDDO
2204                    ENDIF
2205                   
2206                CASE ( 'usm_t_surf_wall' )
2207!
2208!--                 surface temperature for surfaces
2209                    IF ( l == -1 ) THEN
2210                       DO  m = 1, surf_usm_h%ns
2211                       surf_usm_h%t_surf_wall_av(m) =                               & 
2212                                          surf_usm_h%t_surf_wall_av(m) /            &
2213                                             REAL( average_count_3d, kind=wp )
2214                       ENDDO
2215                    ELSE
2216                       DO  m = 1, surf_usm_v(l)%ns
2217                          surf_usm_v(l)%t_surf_wall_av(m) =                         &
2218                                          surf_usm_v(l)%t_surf_wall_av(m) /         &
2219                                          REAL( average_count_3d, kind=wp )
2220                       ENDDO
2221                    ENDIF
2222                   
2223                CASE ( 'usm_t_surf_window' )
2224!
2225!--                 surface temperature for window surfaces
2226                    IF ( l == -1 ) THEN
2227                       DO  m = 1, surf_usm_h%ns
2228                          surf_usm_h%t_surf_window_av(m) =                               &
2229                                             surf_usm_h%t_surf_window_av(m) /            &
2230                                             REAL( average_count_3d, kind=wp )
2231                       ENDDO
2232                    ELSE
2233                       DO  m = 1, surf_usm_v(l)%ns
2234                          surf_usm_v(l)%t_surf_window_av(m) =                         &
2235                                          surf_usm_v(l)%t_surf_window_av(m) /         &
2236                                          REAL( average_count_3d, kind=wp )
2237                       ENDDO
2238                    ENDIF
2239                   
2240                CASE ( 'usm_t_surf_green' )
2241!
2242!--                 surface temperature for green surfaces
2243                    IF ( l == -1 ) THEN
2244                       DO  m = 1, surf_usm_h%ns
2245                          surf_usm_h%t_surf_green_av(m) =                               &
2246                                             surf_usm_h%t_surf_green_av(m) /            &
2247                                             REAL( average_count_3d, kind=wp )
2248                       ENDDO
2249                    ELSE
2250                       DO  m = 1, surf_usm_v(l)%ns
2251                          surf_usm_v(l)%t_surf_green_av(m) =                         &
2252                                          surf_usm_v(l)%t_surf_green_av(m) /         &
2253                                          REAL( average_count_3d, kind=wp )
2254                       ENDDO
2255                    ENDIF
2256                   
2257                CASE ( 'usm_theta_10cm' )
2258!
2259!--                 near surface temperature for whole surfaces
2260                    IF ( l == -1 ) THEN
2261                       DO  m = 1, surf_usm_h%ns
2262                          surf_usm_h%pt_10cm_av(m) =                               &
2263                                             surf_usm_h%pt_10cm_av(m) /            &
2264                                             REAL( average_count_3d, kind=wp )
2265                       ENDDO
2266                    ELSE
2267                       DO  m = 1, surf_usm_v(l)%ns
2268                          surf_usm_v(l)%pt_10cm_av(m) =                         &
2269                                          surf_usm_v(l)%pt_10cm_av(m) /         &
2270                                          REAL( average_count_3d, kind=wp )
2271                       ENDDO
2272                    ENDIF
2273
2274                   
2275                CASE ( 'usm_t_wall' )
2276!
2277!--                 wall temperature for  iwl layer of walls and land
2278                    IF ( l == -1 ) THEN
2279                       DO  m = 1, surf_usm_h%ns
2280                          surf_usm_h%t_wall_av(iwl,m) =                           &
2281                                             surf_usm_h%t_wall_av(iwl,m) /        &
2282                                             REAL( average_count_3d, kind=wp )
2283                       ENDDO
2284                    ELSE
2285                       DO  m = 1, surf_usm_v(l)%ns
2286                          surf_usm_v(l)%t_wall_av(iwl,m) =                     &
2287                                          surf_usm_v(l)%t_wall_av(iwl,m) /     &
2288                                          REAL( average_count_3d, kind=wp )
2289                       ENDDO
2290                    ENDIF
2291
2292                CASE ( 'usm_t_window' )
2293!
2294!--                 window temperature for  iwl layer of walls and land
2295                    IF ( l == -1 ) THEN
2296                       DO  m = 1, surf_usm_h%ns
2297                          surf_usm_h%t_window_av(iwl,m) =                           &
2298                                             surf_usm_h%t_window_av(iwl,m) /        &
2299                                             REAL( average_count_3d, kind=wp )
2300                       ENDDO
2301                    ELSE
2302                       DO  m = 1, surf_usm_v(l)%ns
2303                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
2304                                          surf_usm_v(l)%t_window_av(iwl,m) /     &
2305                                          REAL( average_count_3d, kind=wp )
2306                       ENDDO
2307                    ENDIF
2308
2309                CASE ( 'usm_t_green' )
2310!
2311!--                 green temperature for  iwl layer of walls and land
2312                    IF ( l == -1 ) THEN
2313                       DO  m = 1, surf_usm_h%ns
2314                          surf_usm_h%t_green_av(iwl,m) =                           &
2315                                             surf_usm_h%t_green_av(iwl,m) /        &
2316                                             REAL( average_count_3d, kind=wp )
2317                       ENDDO
2318                    ELSE
2319                       DO  m = 1, surf_usm_v(l)%ns
2320                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
2321                                          surf_usm_v(l)%t_green_av(iwl,m) /     &
2322                                          REAL( average_count_3d, kind=wp )
2323                       ENDDO
2324                    ENDIF
2325                   
2326                CASE ( 'usm_swc' )
2327!
2328!--                 soil water content for  iwl layer of walls and land
2329                    IF ( l == -1 ) THEN
2330                    DO  m = 1, surf_usm_h%ns
2331                       surf_usm_h%swc_av(iwl,m) =                           &
2332                                          surf_usm_h%swc_av(iwl,m) /        &
2333                                          REAL( average_count_3d, kind=wp )
2334                    ENDDO
2335                    ELSE
2336                       DO  m = 1, surf_usm_v(l)%ns
2337                          surf_usm_v(l)%swc_av(iwl,m) =                     &
2338                                          surf_usm_v(l)%swc_av(iwl,m) /     &
2339                                          REAL( average_count_3d, kind=wp )
2340                       ENDDO
2341                    ENDIF
2342
2343
2344           END SELECT
2345
2346        ENDIF
2347
2348        ENDIF
2349
2350    END SUBROUTINE usm_3d_data_averaging
2351
2352
2353
2354!------------------------------------------------------------------------------!
2355! Description:
2356! ------------
2357!> Set internal Neumann boundary condition at outer soil grid points
2358!> for temperature and humidity.
2359!------------------------------------------------------------------------------!
2360 SUBROUTINE usm_boundary_condition
2361 
2362    IMPLICIT NONE
2363
2364    INTEGER(iwp) :: i      !< grid index x-direction
2365    INTEGER(iwp) :: ioff   !< offset index x-direction indicating location of soil grid point
2366    INTEGER(iwp) :: j      !< grid index y-direction
2367    INTEGER(iwp) :: joff   !< offset index x-direction indicating location of soil grid point
2368    INTEGER(iwp) :: k      !< grid index z-direction
2369    INTEGER(iwp) :: koff   !< offset index x-direction indicating location of soil grid point
2370    INTEGER(iwp) :: l      !< running index surface-orientation
2371    INTEGER(iwp) :: m      !< running index surface elements
2372
2373    koff = surf_usm_h%koff
2374    DO  m = 1, surf_usm_h%ns
2375       i = surf_usm_h%i(m)
2376       j = surf_usm_h%j(m)
2377       k = surf_usm_h%k(m)
2378       pt(k+koff,j,i) = pt(k,j,i)
2379    ENDDO
2380
2381    DO  l = 0, 3
2382       ioff = surf_usm_v(l)%ioff
2383       joff = surf_usm_v(l)%joff
2384       DO  m = 1, surf_usm_v(l)%ns
2385          i = surf_usm_v(l)%i(m)
2386          j = surf_usm_v(l)%j(m)
2387          k = surf_usm_v(l)%k(m)
2388          pt(k,j+joff,i+ioff) = pt(k,j,i)
2389       ENDDO
2390    ENDDO
2391
2392 END SUBROUTINE usm_boundary_condition
2393
2394
2395!------------------------------------------------------------------------------!
2396!
2397! Description:
2398! ------------
2399!> Subroutine checks variables and assigns units.
2400!> It is called out from subroutine check_parameters.
2401!------------------------------------------------------------------------------!
2402    SUBROUTINE usm_check_data_output( variable, unit )
2403
2404        IMPLICIT NONE
2405
2406        CHARACTER(LEN=*),INTENT(IN)    ::  variable   !<
2407        CHARACTER(LEN=*),INTENT(OUT)   ::  unit       !<
2408
2409        INTEGER(iwp)                                  :: i,j,l         !< index
2410        CHARACTER(LEN=2)                              :: ls
2411        CHARACTER(LEN=varnamelength)                  :: var           !< TRIM(variable)
2412        INTEGER(iwp), PARAMETER                       :: nl1 = 14      !< number of directional usm variables
2413        CHARACTER(LEN=varnamelength), DIMENSION(nl1)  :: varlist1 = &  !< list of directional usm variables
2414                  (/'usm_wshf                      ', &
2415                    'usm_wghf                      ', &
2416                    'usm_wghf_window               ', &
2417                    'usm_wghf_green                ', &
2418                    'usm_iwghf                     ', &
2419                    'usm_iwghf_window              ', &
2420                    'usm_surfz                     ', &
2421                    'usm_surfwintrans              ', &
2422                    'usm_surfcat                   ', &
2423                    'usm_t_surf_wall               ', &
2424                    'usm_t_surf_window             ', &
2425                    'usm_t_surf_green              ', &
2426                    'usm_t_green                   ', &
2427                    'usm_theta_10cm                '/)
2428
2429        INTEGER(iwp), PARAMETER                       :: nl2 = 3       !< number of directional layer usm variables
2430        CHARACTER(LEN=varnamelength), DIMENSION(nl2)  :: varlist2 = &  !< list of directional layer usm variables
2431                  (/'usm_t_wall                    ', &
2432                    'usm_t_window                  ', &
2433                    'usm_t_green                   '/)
2434
2435        INTEGER(iwp), PARAMETER                       :: nd = 5     !< number of directions
2436        CHARACTER(LEN=6), DIMENSION(nd), PARAMETER  :: dirname = &  !< direction names
2437                  (/'_roof ','_south','_north','_west ','_east '/)
2438        LOGICAL                                       :: lfound     !< flag if the variable is found
2439
2440
2441        lfound = .FALSE.
2442
2443        var = TRIM(variable)
2444
2445!
2446!--     check if variable exists
2447!--     directional variables
2448        DO i = 1, nl1
2449           DO j = 1, nd
2450              IF ( TRIM(var) == TRIM(varlist1(i))//TRIM(dirname(j)) ) THEN
2451                 lfound = .TRUE.
2452                 EXIT
2453              ENDIF
2454              IF ( lfound ) EXIT
2455           ENDDO
2456        ENDDO
2457        IF ( lfound ) GOTO 10
2458!
2459!--     directional layer variables
2460        DO i = 1, nl2
2461           DO j = 1, nd
2462              DO l = nzb_wall, nzt_wall
2463                 WRITE(ls,'(A1,I1)') '_',l
2464                 IF ( TRIM(var) == TRIM(varlist2(i))//TRIM(ls)//TRIM(dirname(j)) ) THEN
2465                    lfound = .TRUE.
2466                    EXIT
2467                 ENDIF
2468              ENDDO
2469              IF ( lfound ) EXIT
2470           ENDDO
2471        ENDDO
2472        IF ( .NOT.  lfound ) THEN
2473           unit = 'illegal'
2474           RETURN
2475        ENDIF
247610      CONTINUE
2477
2478        IF ( var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' .OR.                 &
2479             var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR.     &
2480             var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_'    .OR.      &
2481             var(1:17) == 'usm_surfwintrans_' .OR.                                        &
2482             var(1:9)  == 'usm_qsws_'  .OR.  var(1:13)  == 'usm_qsws_veg_'  .OR.          &
2483             var(1:13) == 'usm_qsws_liq_' ) THEN
2484            unit = 'W/m2'
2485        ELSE IF ( var(1:15) == 'usm_t_surf_wall'   .OR.  var(1:10) == 'usm_t_wall' .OR.   &
2486                  var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR.  &
2487                  var(1:16) == 'usm_t_surf_green'  .OR.                                   &
2488                  var(1:11) == 'usm_t_green' .OR.  var(1:7) == 'usm_swc' .OR.             &
2489                  var(1:14) == 'usm_theta_10cm' )  THEN
2490            unit = 'K'
2491        ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat' )  THEN
2492            unit = '1'
2493        ELSE
2494            unit = 'illegal'
2495        ENDIF
2496
2497    END SUBROUTINE usm_check_data_output
2498
2499
2500!------------------------------------------------------------------------------!
2501! Description:
2502! ------------
2503!> Check parameters routine for urban surface model
2504!------------------------------------------------------------------------------!
2505    SUBROUTINE usm_check_parameters
2506
2507       USE control_parameters,                                                 &
2508           ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, large_scale_forcing,   &
2509                  lsf_surf, topography
2510
2511       USE netcdf_data_input_mod,                                             &
2512            ONLY:  building_type_f
2513
2514       IMPLICIT NONE
2515
2516       INTEGER(iwp) ::  i        !< running index, x-dimension
2517       INTEGER(iwp) ::  j        !< running index, y-dimension
2518
2519!
2520!--    Dirichlet boundary conditions are required as the surface fluxes are
2521!--    calculated from the temperature/humidity gradients in the urban surface
2522!--    model
2523       IF ( bc_pt_b == 'neumann'   .OR.   bc_q_b == 'neumann' )  THEN
2524          message_string = 'urban surface model requires setting of '//        &
2525                           'bc_pt_b = "dirichlet" and '//                      &
2526                           'bc_q_b  = "dirichlet"'
2527          CALL message( 'usm_check_parameters', 'PA0590', 1, 2, 0, 6, 0 )
2528       ENDIF
2529
2530       IF ( .NOT.  constant_flux_layer )  THEN
2531          message_string = 'urban surface model requires '//                   &
2532                           'constant_flux_layer = .T.'
2533          CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2534       ENDIF
2535
2536       IF (  .NOT.  radiation )  THEN
2537          message_string = 'urban surface model requires '//                   &
2538                           'the radiation model to be switched on'
2539          CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2540       ENDIF
2541!       
2542!--    Surface forcing has to be disabled for LSF in case of enabled
2543!--    urban surface module
2544       IF ( large_scale_forcing )  THEN
2545          lsf_surf = .FALSE.
2546       ENDIF
2547!
2548!--    Topography
2549       IF ( topography == 'flat' )  THEN
2550          message_string = 'topography /= "flat" is required '//               &
2551                           'when using the urban surface model'
2552          CALL message( 'usm_check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
2553       ENDIF
2554!
2555!--    naheatlayers
2556       IF ( naheatlayers > nzt )  THEN
2557          message_string = 'number of anthropogenic heat layers '//            &
2558                           '"naheatlayers" can not be larger than'//           &
2559                           ' number of domain layers "nzt"'
2560          CALL message( 'usm_check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
2561       ENDIF
2562!
2563!--    Check if building types are set within a valid range.
2564       IF ( building_type < LBOUND( building_pars, 2 )  .AND.                  &
2565            building_type > UBOUND( building_pars, 2 ) )  THEN
2566          WRITE( message_string, * ) 'building_type = ', building_type,        &
2567                                     ' is out of the valid range'
2568          CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
2569       ENDIF
2570       IF ( building_type_f%from_file )  THEN
2571          DO  i = nxl, nxr
2572             DO  j = nys, nyn
2573                IF ( building_type_f%var(j,i) /= building_type_f%fill  .AND.   &
2574              ( building_type_f%var(j,i) < LBOUND( building_pars, 2 )  .OR.    &
2575                building_type_f%var(j,i) > UBOUND( building_pars, 2 ) ) )      &
2576                THEN
2577                   WRITE( message_string, * ) 'building_type = is out of ' //  &
2578                                        'the valid range at (j,i) = ', j, i
2579                   CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
2580                ENDIF
2581             ENDDO
2582          ENDDO
2583       ENDIF
2584    END SUBROUTINE usm_check_parameters
2585
2586
2587!------------------------------------------------------------------------------!
2588!
2589! Description:
2590! ------------
2591!> Output of the 3D-arrays in netCDF and/or AVS format
2592!> for variables of urban_surface model.
2593!> It resorts the urban surface module output quantities from surf style
2594!> indexing into temporary 3D array with indices (i,j,k).
2595!> It is called from subroutine data_output_3d.
2596!------------------------------------------------------------------------------!
2597    SUBROUTINE usm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
2598       
2599        IMPLICIT NONE
2600
2601        INTEGER(iwp), INTENT(IN)       ::  av        !< flag if averaged
2602        CHARACTER (len=*), INTENT(IN)  ::  variable  !< variable name
2603        INTEGER(iwp), INTENT(IN)       ::  nzb_do    !< lower limit of the data output (usually 0)
2604        INTEGER(iwp), INTENT(IN)       ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
2605        LOGICAL, INTENT(OUT)           ::  found     !<
2606        REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< sp - it has to correspond to module data_output_3d
2607        REAL(sp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf    !< temp array for urban surface output procedure
2608       
2609        CHARACTER (len=varnamelength)                      :: var     !< trimmed variable name
2610        INTEGER(iwp), PARAMETER                            :: nd = 5  !< number of directions
2611        CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
2612        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
2613        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: diridx =  (/       -1,        1,        0,        3,        2 /)
2614                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
2615        INTEGER(iwp)                   :: ids,idsint,idsidx
2616        INTEGER(iwp)                   :: i,j,k,iwl,istat, l, m  !< running indices
2617
2618        found = .TRUE.
2619        temp_pf = -1._wp
2620       
2621        ids = -1
2622        var = TRIM(variable)
2623        DO i = 0, nd-1
2624            k = len(TRIM(var))
2625            j = len(TRIM(dirname(i)))
2626            IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
2627                ids = i
2628                idsint = dirint(ids)
2629                idsidx = diridx(ids)
2630                var = var(:k-j)
2631                EXIT
2632            ENDIF
2633        ENDDO
2634        IF ( ids == -1 )  THEN
2635            var = TRIM(variable)
2636        ENDIF
2637        IF ( var(1:11) == 'usm_t_wall_'  .AND.  len(TRIM(var)) >= 12 )  THEN
2638!
2639!--         wall layers
2640            READ(var(12:12), '(I1)', iostat=istat ) iwl
2641            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2642                var = var(1:10)
2643            ENDIF
2644        ENDIF
2645        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
2646!
2647!--         window layers
2648            READ(var(14:14), '(I1)', iostat=istat ) iwl
2649            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2650                var = var(1:12)
2651            ENDIF
2652        ENDIF
2653        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
2654!
2655!--         green layers
2656            READ(var(13:13), '(I1)', iostat=istat ) iwl
2657            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2658                var = var(1:11)
2659            ENDIF
2660        ENDIF
2661        IF ( var(1:8) == 'usm_swc_'  .AND.  len(TRIM(var)) >= 9 )  THEN
2662!
2663!--         green layers soil water content
2664            READ(var(9:9), '(I1)', iostat=istat ) iwl
2665            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2666                var = var(1:7)
2667            ENDIF
2668        ENDIF
2669       
2670        SELECT CASE ( TRIM(var) )
2671
2672          CASE ( 'usm_surfz' )
2673!
2674!--           array of surface height (z)
2675              IF ( idsint == iup_u )  THEN
2676                 DO  m = 1, surf_usm_h%ns
2677                    i = surf_usm_h%i(m)
2678                    j = surf_usm_h%j(m)
2679                    k = surf_usm_h%k(m)
2680                    temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) )
2681                 ENDDO
2682              ELSE
2683                 l = idsidx
2684                 DO  m = 1, surf_usm_v(l)%ns
2685                    i = surf_usm_v(l)%i(m)
2686                    j = surf_usm_v(l)%j(m)
2687                    k = surf_usm_v(l)%k(m)
2688                    temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) + 1.0_sp )
2689                 ENDDO
2690              ENDIF
2691
2692          CASE ( 'usm_surfcat' )
2693!
2694!--           surface category
2695              IF ( idsint == iup_u )  THEN
2696                 DO  m = 1, surf_usm_h%ns
2697                    i = surf_usm_h%i(m)
2698                    j = surf_usm_h%j(m)
2699                    k = surf_usm_h%k(m)
2700                    temp_pf(k,j,i) = surf_usm_h%surface_types(m)
2701                 ENDDO
2702              ELSE
2703                 l = idsidx
2704                 DO  m = 1, surf_usm_v(l)%ns
2705                    i = surf_usm_v(l)%i(m)
2706                    j = surf_usm_v(l)%j(m)
2707                    k = surf_usm_v(l)%k(m)
2708                    temp_pf(k,j,i) = surf_usm_v(l)%surface_types(m)
2709                 ENDDO
2710              ENDIF
2711             
2712          CASE ( 'usm_surfwintrans' )
2713!
2714!--           transmissivity window tiles
2715              IF ( idsint == iup_u )  THEN
2716                 DO  m = 1, surf_usm_h%ns
2717                    i = surf_usm_h%i(m)
2718                    j = surf_usm_h%j(m)
2719                    k = surf_usm_h%k(m)
2720                    temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
2721                 ENDDO
2722              ELSE
2723                 l = idsidx
2724                 DO  m = 1, surf_usm_v(l)%ns
2725                    i = surf_usm_v(l)%i(m)
2726                    j = surf_usm_v(l)%j(m)
2727                    k = surf_usm_v(l)%k(m)
2728                    temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
2729                 ENDDO
2730              ENDIF
2731
2732          CASE ( 'usm_wshf' )
2733!
2734!--           array of sensible heat flux from surfaces
2735              IF ( av == 0 )  THEN
2736                 IF ( idsint == iup_u )  THEN
2737                    DO  m = 1, surf_usm_h%ns
2738                       i = surf_usm_h%i(m)
2739                       j = surf_usm_h%j(m)
2740                       k = surf_usm_h%k(m)
2741                       temp_pf(k,j,i) = surf_usm_h%wshf_eb(m)
2742                    ENDDO
2743                 ELSE
2744                    l = idsidx
2745                    DO  m = 1, surf_usm_v(l)%ns
2746                       i = surf_usm_v(l)%i(m)
2747                       j = surf_usm_v(l)%j(m)
2748                       k = surf_usm_v(l)%k(m)
2749                       temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb(m)
2750                    ENDDO
2751                 ENDIF
2752              ELSE
2753                 IF ( idsint == iup_u )  THEN
2754                    DO  m = 1, surf_usm_h%ns
2755                       i = surf_usm_h%i(m)
2756                       j = surf_usm_h%j(m)
2757                       k = surf_usm_h%k(m)
2758                       temp_pf(k,j,i) = surf_usm_h%wshf_eb_av(m)
2759                    ENDDO
2760                 ELSE
2761                    l = idsidx
2762                    DO  m = 1, surf_usm_v(l)%ns
2763                       i = surf_usm_v(l)%i(m)
2764                       j = surf_usm_v(l)%j(m)
2765                       k = surf_usm_v(l)%k(m)
2766                       temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb_av(m)
2767                    ENDDO
2768                 ENDIF
2769              ENDIF
2770             
2771             
2772          CASE ( 'usm_qsws' )
2773!
2774!--           array of latent heat flux from surfaces
2775              IF ( av == 0 )  THEN
2776                 IF ( idsint == iup_u )  THEN
2777                    DO  m = 1, surf_usm_h%ns
2778                       i = surf_usm_h%i(m)
2779                       j = surf_usm_h%j(m)
2780                       k = surf_usm_h%k(m)
2781                       temp_pf(k,j,i) = surf_usm_h%qsws_eb(m)
2782                    ENDDO
2783                 ELSE
2784                    l = idsidx
2785                    DO  m = 1, surf_usm_v(l)%ns
2786                       i = surf_usm_v(l)%i(m)
2787                       j = surf_usm_v(l)%j(m)
2788                       k = surf_usm_v(l)%k(m)
2789                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_eb(m)
2790                    ENDDO
2791                 ENDIF
2792              ELSE
2793                 IF ( idsint == iup_u )  THEN
2794                    DO  m = 1, surf_usm_h%ns
2795                       i = surf_usm_h%i(m)
2796                       j = surf_usm_h%j(m)
2797                       k = surf_usm_h%k(m)
2798                       temp_pf(k,j,i) = surf_usm_h%qsws_eb_av(m)
2799                    ENDDO
2800                 ELSE
2801                    l = idsidx
2802                    DO  m = 1, surf_usm_v(l)%ns
2803                       i = surf_usm_v(l)%i(m)
2804                       j = surf_usm_v(l)%j(m)
2805                       k = surf_usm_v(l)%k(m)
2806                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_eb_av(m)
2807                    ENDDO
2808                 ENDIF
2809              ENDIF
2810             
2811          CASE ( 'usm_qsws_veg' )
2812!
2813!--           array of latent heat flux from vegetation surfaces
2814              IF ( av == 0 )  THEN
2815                 IF ( idsint == iup_u )  THEN
2816                    DO  m = 1, surf_usm_h%ns
2817                       i = surf_usm_h%i(m)
2818                       j = surf_usm_h%j(m)
2819                       k = surf_usm_h%k(m)
2820                       temp_pf(k,j,i) = surf_usm_h%qsws_veg(m)
2821                    ENDDO
2822                 ELSE
2823                    l = idsidx
2824                    DO  m = 1, surf_usm_v(l)%ns
2825                       i = surf_usm_v(l)%i(m)
2826                       j = surf_usm_v(l)%j(m)
2827                       k = surf_usm_v(l)%k(m)
2828                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg(m)
2829                    ENDDO
2830                 ENDIF
2831              ELSE
2832                 IF ( idsint == iup_u )  THEN
2833                    DO  m = 1, surf_usm_h%ns
2834                       i = surf_usm_h%i(m)
2835                       j = surf_usm_h%j(m)
2836                       k = surf_usm_h%k(m)
2837                       temp_pf(k,j,i) = surf_usm_h%qsws_veg_av(m)
2838                    ENDDO
2839                 ELSE
2840                    l = idsidx
2841                    DO  m = 1, surf_usm_v(l)%ns
2842                       i = surf_usm_v(l)%i(m)
2843                       j = surf_usm_v(l)%j(m)
2844                       k = surf_usm_v(l)%k(m)
2845                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_av(m)
2846                    ENDDO
2847                 ENDIF
2848              ENDIF
2849             
2850          CASE ( 'usm_qsws_liq' )
2851!
2852!--           array of latent heat flux from surfaces with liquid
2853              IF ( av == 0 )  THEN
2854                 IF ( idsint == iup_u )  THEN
2855                    DO  m = 1, surf_usm_h%ns
2856                       i = surf_usm_h%i(m)
2857                       j = surf_usm_h%j(m)
2858                       k = surf_usm_h%k(m)
2859                       temp_pf(k,j,i) = surf_usm_h%qsws_liq(m)
2860                    ENDDO
2861                 ELSE
2862                    l = idsidx
2863                    DO  m = 1, surf_usm_v(l)%ns
2864                       i = surf_usm_v(l)%i(m)
2865                       j = surf_usm_v(l)%j(m)
2866                       k = surf_usm_v(l)%k(m)
2867                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq(m)
2868                    ENDDO
2869                 ENDIF
2870              ELSE
2871                 IF ( idsint == iup_u )  THEN
2872                    DO  m = 1, surf_usm_h%ns
2873                       i = surf_usm_h%i(m)
2874                       j = surf_usm_h%j(m)
2875                       k = surf_usm_h%k(m)
2876                       temp_pf(k,j,i) = surf_usm_h%qsws_liq_av(m)
2877                    ENDDO
2878                 ELSE
2879                    l = idsidx
2880                    DO  m = 1, surf_usm_v(l)%ns
2881                       i = surf_usm_v(l)%i(m)
2882                       j = surf_usm_v(l)%j(m)
2883                       k = surf_usm_v(l)%k(m)
2884                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_av(m)
2885                    ENDDO
2886                 ENDIF
2887              ENDIF
2888
2889          CASE ( 'usm_wghf' )
2890!
2891!--           array of heat flux from ground (land, wall, roof)
2892              IF ( av == 0 )  THEN
2893                 IF ( idsint == iup_u )  THEN
2894                    DO  m = 1, surf_usm_h%ns
2895                       i = surf_usm_h%i(m)
2896                       j = surf_usm_h%j(m)
2897                       k = surf_usm_h%k(m)
2898                       temp_pf(k,j,i) = surf_usm_h%wghf_eb(m)
2899                    ENDDO
2900                 ELSE
2901                    l = idsidx
2902                    DO  m = 1, surf_usm_v(l)%ns
2903                       i = surf_usm_v(l)%i(m)
2904                       j = surf_usm_v(l)%j(m)
2905                       k = surf_usm_v(l)%k(m)
2906                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb(m)
2907                    ENDDO
2908                 ENDIF
2909              ELSE
2910                 IF ( idsint == iup_u )  THEN
2911                    DO  m = 1, surf_usm_h%ns
2912                       i = surf_usm_h%i(m)
2913                       j = surf_usm_h%j(m)
2914                       k = surf_usm_h%k(m)
2915                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_av(m)
2916                    ENDDO
2917                 ELSE
2918                    l = idsidx
2919                    DO  m = 1, surf_usm_v(l)%ns
2920                       i = surf_usm_v(l)%i(m)
2921                       j = surf_usm_v(l)%j(m)
2922                       k = surf_usm_v(l)%k(m)
2923                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_av(m)
2924                    ENDDO
2925                 ENDIF
2926              ENDIF
2927
2928          CASE ( 'usm_wghf_window' )
2929!
2930!--           array of heat flux from window ground (land, wall, roof)
2931              IF ( av == 0 )  THEN
2932                 IF ( idsint == iup_u )  THEN
2933                    DO  m = 1, surf_usm_h%ns
2934                       i = surf_usm_h%i(m)
2935                       j = surf_usm_h%j(m)
2936                       k = surf_usm_h%k(m)
2937                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
2938                    ENDDO
2939                 ELSE
2940                    l = idsidx
2941                    DO  m = 1, surf_usm_v(l)%ns
2942                       i = surf_usm_v(l)%i(m)
2943                       j = surf_usm_v(l)%j(m)
2944                       k = surf_usm_v(l)%k(m)
2945                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
2946                    ENDDO
2947                 ENDIF
2948              ELSE
2949                 IF ( idsint == iup_u )  THEN
2950                    DO  m = 1, surf_usm_h%ns
2951                       i = surf_usm_h%i(m)
2952                       j = surf_usm_h%j(m)
2953                       k = surf_usm_h%k(m)
2954                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
2955                    ENDDO
2956                 ELSE
2957                    l = idsidx
2958                    DO  m = 1, surf_usm_v(l)%ns
2959                       i = surf_usm_v(l)%i(m)
2960                       j = surf_usm_v(l)%j(m)
2961                       k = surf_usm_v(l)%k(m)
2962                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
2963                    ENDDO
2964                 ENDIF
2965              ENDIF
2966
2967          CASE ( 'usm_wghf_green' )
2968!
2969!--           array of heat flux from green ground (land, wall, roof)
2970              IF ( av == 0 )  THEN
2971                 IF ( idsint == iup_u )  THEN
2972                    DO  m = 1, surf_usm_h%ns
2973                       i = surf_usm_h%i(m)
2974                       j = surf_usm_h%j(m)
2975                       k = surf_usm_h%k(m)
2976                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
2977                    ENDDO
2978                 ELSE
2979                    l = idsidx
2980                    DO  m = 1, surf_usm_v(l)%ns
2981                       i = surf_usm_v(l)%i(m)
2982                       j = surf_usm_v(l)%j(m)
2983                       k = surf_usm_v(l)%k(m)
2984                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
2985                    ENDDO
2986                 ENDIF
2987              ELSE
2988                 IF ( idsint == iup_u )  THEN
2989                    DO  m = 1, surf_usm_h%ns
2990                       i = surf_usm_h%i(m)
2991                       j = surf_usm_h%j(m)
2992                       k = surf_usm_h%k(m)
2993                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
2994                    ENDDO
2995                 ELSE
2996                    l = idsidx
2997                    DO  m = 1, surf_usm_v(l)%ns
2998                       i = surf_usm_v(l)%i(m)
2999                       j = surf_usm_v(l)%j(m)
3000                       k = surf_usm_v(l)%k(m)
3001                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
3002                    ENDDO
3003                 ENDIF
3004              ENDIF
3005
3006          CASE ( 'usm_iwghf' )
3007!
3008!--           array of heat flux from indoor ground (land, wall, roof)
3009              IF ( av == 0 )  THEN
3010                 IF ( idsint == iup_u )  THEN
3011                    DO  m = 1, surf_usm_h%ns
3012                       i = surf_usm_h%i(m)
3013                       j = surf_usm_h%j(m)
3014                       k = surf_usm_h%k(m)
3015                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
3016                    ENDDO
3017                 ELSE
3018                    l = idsidx
3019                    DO  m = 1, surf_usm_v(l)%ns
3020                       i = surf_usm_v(l)%i(m)
3021                       j = surf_usm_v(l)%j(m)
3022                       k = surf_usm_v(l)%k(m)
3023                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
3024                    ENDDO
3025                 ENDIF
3026              ELSE
3027                 IF ( idsint == iup_u )  THEN
3028                    DO  m = 1, surf_usm_h%ns
3029                       i = surf_usm_h%i(m)
3030                       j = surf_usm_h%j(m)
3031                       k = surf_usm_h%k(m)
3032                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
3033                    ENDDO
3034                 ELSE
3035                    l = idsidx
3036                    DO  m = 1, surf_usm_v(l)%ns
3037                       i = surf_usm_v(l)%i(m)
3038                       j = surf_usm_v(l)%j(m)
3039                       k = surf_usm_v(l)%k(m)
3040                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
3041                    ENDDO
3042                 ENDIF
3043              ENDIF
3044
3045          CASE ( 'usm_iwghf_window' )
3046!
3047!--           array of heat flux from indoor window ground (land, wall, roof)
3048              IF ( av == 0 )  THEN
3049                 IF ( idsint == iup_u )  THEN
3050                    DO  m = 1, surf_usm_h%ns
3051                       i = surf_usm_h%i(m)
3052                       j = surf_usm_h%j(m)
3053                       k = surf_usm_h%k(m)
3054                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(m)
3055                    ENDDO
3056                 ELSE
3057                    l = idsidx
3058                    DO  m = 1, surf_usm_v(l)%ns
3059                       i = surf_usm_v(l)%i(m)
3060                       j = surf_usm_v(l)%j(m)
3061                       k = surf_usm_v(l)%k(m)
3062                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
3063                    ENDDO
3064                 ENDIF
3065              ELSE
3066                 IF ( idsint == iup_u )  THEN
3067                    DO  m = 1, surf_usm_h%ns
3068                       i = surf_usm_h%i(m)
3069                       j = surf_usm_h%j(m)
3070                       k = surf_usm_h%k(m)
3071                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
3072                    ENDDO
3073                 ELSE
3074                    l = idsidx
3075                    DO  m = 1, surf_usm_v(l)%ns
3076                       i = surf_usm_v(l)%i(m)
3077                       j = surf_usm_v(l)%j(m)
3078                       k = surf_usm_v(l)%k(m)
3079                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
3080                    ENDDO
3081                 ENDIF
3082              ENDIF
3083             
3084          CASE ( 'usm_t_surf_wall' )
3085!
3086!--           surface temperature for surfaces
3087              IF ( av == 0 )  THEN
3088                 IF ( idsint == iup_u )  THEN
3089                    DO  m = 1, surf_usm_h%ns
3090                       i = surf_usm_h%i(m)
3091                       j = surf_usm_h%j(m)
3092                       k = surf_usm_h%k(m)
3093                       temp_pf(k,j,i) = t_surf_wall_h(m)
3094                    ENDDO
3095                 ELSE
3096                    l = idsidx
3097                    DO  m = 1, surf_usm_v(l)%ns
3098                       i = surf_usm_v(l)%i(m)
3099                       j = surf_usm_v(l)%j(m)
3100                       k = surf_usm_v(l)%k(m)
3101                       temp_pf(k,j,i) = t_surf_wall_v(l)%t(m)
3102                    ENDDO
3103                 ENDIF
3104              ELSE
3105                 IF ( idsint == iup_u )  THEN
3106                    DO  m = 1, surf_usm_h%ns
3107                       i = surf_usm_h%i(m)
3108                       j = surf_usm_h%j(m)
3109                       k = surf_usm_h%k(m)
3110                       temp_pf(k,j,i) = surf_usm_h%t_surf_wall_av(m)
3111                    ENDDO
3112                 ELSE
3113                    l = idsidx
3114                    DO  m = 1, surf_usm_v(l)%ns
3115                       i = surf_usm_v(l)%i(m)
3116                       j = surf_usm_v(l)%j(m)
3117                       k = surf_usm_v(l)%k(m)
3118                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_wall_av(m)
3119                    ENDDO
3120                 ENDIF
3121              ENDIF
3122             
3123          CASE ( 'usm_t_surf_window' )
3124!
3125!--           surface temperature for window surfaces
3126              IF ( av == 0 )  THEN
3127                 IF ( idsint == iup_u )  THEN
3128                    DO  m = 1, surf_usm_h%ns
3129                       i = surf_usm_h%i(m)
3130                       j = surf_usm_h%j(m)
3131                       k = surf_usm_h%k(m)
3132                       temp_pf(k,j,i) = t_surf_window_h(m)
3133                    ENDDO
3134                 ELSE
3135                    l = idsidx
3136                    DO  m = 1, surf_usm_v(l)%ns
3137                       i = surf_usm_v(l)%i(m)
3138                       j = surf_usm_v(l)%j(m)
3139                       k = surf_usm_v(l)%k(m)
3140                       temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
3141                    ENDDO
3142                 ENDIF
3143
3144              ELSE
3145                 IF ( idsint == iup_u )  THEN
3146                    DO  m = 1, surf_usm_h%ns
3147                       i = surf_usm_h%i(m)
3148                       j = surf_usm_h%j(m)
3149                       k = surf_usm_h%k(m)
3150                       temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
3151                    ENDDO
3152                 ELSE
3153                    l = idsidx
3154                    DO  m = 1, surf_usm_v(l)%ns
3155                       i = surf_usm_v(l)%i(m)
3156                       j = surf_usm_v(l)%j(m)
3157                       k = surf_usm_v(l)%k(m)
3158                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
3159                    ENDDO
3160
3161                 ENDIF
3162
3163              ENDIF
3164
3165          CASE ( 'usm_t_surf_green' )
3166!
3167!--           surface temperature for green surfaces
3168              IF ( av == 0 )  THEN
3169                 IF ( idsint == iup_u )  THEN
3170                    DO  m = 1, surf_usm_h%ns
3171                       i = surf_usm_h%i(m)
3172                       j = surf_usm_h%j(m)
3173                       k = surf_usm_h%k(m)
3174                       temp_pf(k,j,i) = t_surf_green_h(m)
3175                    ENDDO
3176                 ELSE
3177                    l = idsidx
3178                    DO  m = 1, surf_usm_v(l)%ns
3179                       i = surf_usm_v(l)%i(m)
3180                       j = surf_usm_v(l)%j(m)
3181                       k = surf_usm_v(l)%k(m)
3182                       temp_pf(k,j,i) = t_surf_green_v(l)%t(m)
3183                    ENDDO
3184                 ENDIF
3185
3186              ELSE
3187                 IF ( idsint == iup_u )  THEN
3188                    DO  m = 1, surf_usm_h%ns
3189                       i = surf_usm_h%i(m)
3190                       j = surf_usm_h%j(m)
3191                       k = surf_usm_h%k(m)
3192                       temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
3193                    ENDDO
3194                 ELSE
3195                    l = idsidx
3196                    DO  m = 1, surf_usm_v(l)%ns
3197                       i = surf_usm_v(l)%i(m)
3198                       j = surf_usm_v(l)%j(m)
3199                       k = surf_usm_v(l)%k(m)
3200                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
3201                    ENDDO
3202
3203                 ENDIF
3204
3205              ENDIF
3206
3207          CASE ( 'usm_theta_10cm' )
3208!
3209!--           near surface temperature for whole surfaces
3210              IF ( av == 0 )  THEN
3211                 IF ( idsint == iup_u )  THEN
3212                    DO  m = 1, surf_usm_h%ns
3213                       i = surf_usm_h%i(m)
3214                       j = surf_usm_h%j(m)
3215                       k = surf_usm_h%k(m)
3216                       temp_pf(k,j,i) = surf_usm_h%pt_10cm(m)
3217                    ENDDO
3218                 ELSE
3219                    l = idsidx
3220                    DO  m = 1, surf_usm_v(l)%ns
3221                       i = surf_usm_v(l)%i(m)
3222                       j = surf_usm_v(l)%j(m)
3223                       k = surf_usm_v(l)%k(m)
3224                       temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm(m)
3225                    ENDDO
3226                 ENDIF
3227             
3228             
3229              ELSE
3230                 IF ( idsint == iup_u )  THEN
3231                    DO  m = 1, surf_usm_h%ns
3232                       i = surf_usm_h%i(m)
3233                       j = surf_usm_h%j(m)
3234                       k = surf_usm_h%k(m)
3235                       temp_pf(k,j,i) = surf_usm_h%pt_10cm_av(m)
3236                    ENDDO
3237                 ELSE
3238                    l = idsidx
3239                    DO  m = 1, surf_usm_v(l)%ns
3240                       i = surf_usm_v(l)%i(m)
3241                       j = surf_usm_v(l)%j(m)
3242                       k = surf_usm_v(l)%k(m)
3243                       temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm_av(m)
3244                    ENDDO
3245
3246                  ENDIF
3247              ENDIF
3248             
3249          CASE ( 'usm_t_wall' )
3250!
3251!--           wall temperature for  iwl layer of walls and land
3252              IF ( av == 0 )  THEN
3253                 IF ( idsint == iup_u )  THEN
3254                    DO  m = 1, surf_usm_h%ns
3255                       i = surf_usm_h%i(m)
3256                       j = surf_usm_h%j(m)
3257                       k = surf_usm_h%k(m)
3258                       temp_pf(k,j,i) = t_wall_h(iwl,m)
3259                    ENDDO
3260                 ELSE
3261                    l = idsidx
3262                    DO  m = 1, surf_usm_v(l)%ns
3263                       i = surf_usm_v(l)%i(m)
3264                       j = surf_usm_v(l)%j(m)
3265                       k = surf_usm_v(l)%k(m)
3266                       temp_pf(k,j,i) = t_wall_v(l)%t(iwl,m)
3267                    ENDDO
3268                 ENDIF
3269              ELSE
3270                 IF ( idsint == iup_u )  THEN
3271                    DO  m = 1, surf_usm_h%ns
3272                       i = surf_usm_h%i(m)
3273                       j = surf_usm_h%j(m)
3274                       k = surf_usm_h%k(m)
3275                       temp_pf(k,j,i) = surf_usm_h%t_wall_av(iwl,m)
3276                    ENDDO
3277                 ELSE
3278                    l = idsidx
3279                    DO  m = 1, surf_usm_v(l)%ns
3280                       i = surf_usm_v(l)%i(m)
3281                       j = surf_usm_v(l)%j(m)
3282                       k = surf_usm_v(l)%k(m)
3283                       temp_pf(k,j,i) = surf_usm_v(l)%t_wall_av(iwl,m)
3284                    ENDDO
3285                 ENDIF
3286              ENDIF
3287             
3288          CASE ( 'usm_t_window' )
3289!
3290!--           window temperature for iwl layer of walls and land
3291              IF ( av == 0 )  THEN
3292                 IF ( idsint == iup_u )  THEN
3293                    DO  m = 1, surf_usm_h%ns
3294                       i = surf_usm_h%i(m)
3295                       j = surf_usm_h%j(m)
3296                       k = surf_usm_h%k(m)
3297                       temp_pf(k,j,i) = t_window_h(iwl,m)
3298                    ENDDO
3299                 ELSE
3300                    l = idsidx
3301                    DO  m = 1, surf_usm_v(l)%ns
3302                       i = surf_usm_v(l)%i(m)
3303                       j = surf_usm_v(l)%j(m)
3304                       k = surf_usm_v(l)%k(m)
3305                       temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
3306                    ENDDO
3307                 ENDIF
3308              ELSE
3309                 IF ( idsint == iup_u )  THEN
3310                    DO  m = 1, surf_usm_h%ns
3311                       i = surf_usm_h%i(m)
3312                       j = surf_usm_h%j(m)
3313                       k = surf_usm_h%k(m)
3314                       temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
3315                    ENDDO
3316                 ELSE
3317                    l = idsidx
3318                    DO  m = 1, surf_usm_v(l)%ns
3319                       i = surf_usm_v(l)%i(m)
3320                       j = surf_usm_v(l)%j(m)
3321                       k = surf_usm_v(l)%k(m)
3322                       temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
3323                    ENDDO
3324                 ENDIF
3325              ENDIF
3326
3327          CASE ( 'usm_t_green' )
3328!
3329!--           green temperature for  iwl layer of walls and land
3330              IF ( av == 0 )  THEN
3331                 IF ( idsint == iup_u )  THEN
3332                    DO  m = 1, surf_usm_h%ns
3333                       i = surf_usm_h%i(m)
3334                       j = surf_usm_h%j(m)
3335                       k = surf_usm_h%k(m)
3336                       temp_pf(k,j,i) = t_green_h(iwl,m)
3337                    ENDDO
3338                 ELSE
3339                    l = idsidx
3340                    DO  m = 1, surf_usm_v(l)%ns
3341                       i = surf_usm_v(l)%i(m)
3342                       j = surf_usm_v(l)%j(m)
3343                       k = surf_usm_v(l)%k(m)
3344                       temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
3345                    ENDDO
3346                 ENDIF
3347              ELSE
3348                 IF ( idsint == iup_u )  THEN
3349                    DO  m = 1, surf_usm_h%ns
3350                       i = surf_usm_h%i(m)
3351                       j = surf_usm_h%j(m)
3352                       k = surf_usm_h%k(m)
3353                       temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
3354                    ENDDO
3355                 ELSE
3356                    l = idsidx
3357                    DO  m = 1, surf_usm_v(l)%ns
3358                       i = surf_usm_v(l)%i(m)
3359                       j = surf_usm_v(l)%j(m)
3360                       k = surf_usm_v(l)%k(m)
3361                       temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
3362                    ENDDO
3363                 ENDIF
3364              ENDIF
3365             
3366              CASE ( 'usm_swc' )
3367!
3368!--           soil water content for  iwl layer of walls and land
3369              IF ( av == 0 )  THEN
3370                 IF ( idsint == iup_u )  THEN
3371                    DO  m = 1, surf_usm_h%ns
3372                       i = surf_usm_h%i(m)
3373                       j = surf_usm_h%j(m)
3374                       k = surf_usm_h%k(m)
3375                       temp_pf(k,j,i) = swc_h(iwl,m)
3376                    ENDDO
3377                 ELSE
3378                    l = idsidx
3379                    DO  m = 1, surf_usm_v(l)%ns
3380                       i = surf_usm_v(l)%i(m)
3381                       j = surf_usm_v(l)%j(m)
3382                       k = surf_usm_v(l)%k(m)
3383                       temp_pf(k,j,i) = swc_v(l)%t(iwl,m)
3384                    ENDDO
3385                 ENDIF
3386              ELSE
3387                 IF ( idsint == iup_u )  THEN
3388                    DO  m = 1, surf_usm_h%ns
3389                       i = surf_usm_h%i(m)
3390                       j = surf_usm_h%j(m)
3391                       k = surf_usm_h%k(m)
3392                       temp_pf(k,j,i) = surf_usm_h%swc_av(iwl,m)
3393                    ENDDO
3394                 ELSE
3395                    l = idsidx
3396                    DO  m = 1, surf_usm_v(l)%ns
3397                       i = surf_usm_v(l)%i(m)
3398                       j = surf_usm_v(l)%j(m)
3399                       k = surf_usm_v(l)%k(m)
3400                       temp_pf(k,j,i) = surf_usm_v(l)%swc_av(iwl,m)
3401                    ENDDO
3402                 ENDIF
3403              ENDIF
3404
3405             
3406          CASE DEFAULT
3407              found = .FALSE.
3408              RETURN
3409        END SELECT
3410
3411!
3412!--     Rearrange dimensions for NetCDF output
3413!--     FIXME: this may generate FPE overflow upon conversion from DP to SP
3414        DO  j = nys, nyn
3415            DO  i = nxl, nxr
3416                DO  k = nzb_do, nzt_do
3417                    local_pf(i,j,k) = temp_pf(k,j,i)
3418                ENDDO
3419            ENDDO
3420        ENDDO
3421       
3422    END SUBROUTINE usm_data_output_3d
3423   
3424
3425!------------------------------------------------------------------------------!
3426!
3427! Description:
3428! ------------
3429!> Soubroutine defines appropriate grid for netcdf variables.
3430!> It is called out from subroutine netcdf.
3431!------------------------------------------------------------------------------!
3432    SUBROUTINE usm_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
3433   
3434        IMPLICIT NONE
3435
3436        CHARACTER (len=*), INTENT(IN)  ::  variable    !<
3437        LOGICAL, INTENT(OUT)           ::  found       !<
3438        CHARACTER (len=*), INTENT(OUT) ::  grid_x      !<
3439        CHARACTER (len=*), INTENT(OUT) ::  grid_y      !<
3440        CHARACTER (len=*), INTENT(OUT) ::  grid_z      !<
3441
3442        CHARACTER (len=varnamelength)  :: var
3443
3444        var = TRIM(variable)
3445        IF ( var(1:9) == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_'  .OR.                   &
3446             var(1:16) == 'usm_wghf_window_'  .OR. var(1:15) == 'usm_wghf_green_' .OR.      &
3447             var(1:10) == 'usm_iwghf_'  .OR. var(1:17) == 'usm_iwghf_window_' .OR.          &
3448             var(1:9) == 'usm_qsws_'  .OR.  var(1:13) == 'usm_qsws_veg_'  .OR.              &
3449             var(1:13) == 'usm_qsws_liq_' .OR.                                              &
3450             var(1:15) == 'usm_t_surf_wall'  .OR.  var(1:10) == 'usm_t_wall'  .OR.          &
3451             var(1:17) == 'usm_t_surf_window'  .OR.  var(1:12) == 'usm_t_window'  .OR.      &
3452             var(1:16) == 'usm_t_surf_green'  .OR. var(1:11) == 'usm_t_green' .OR.          &
3453             var(1:15) == 'usm_theta_10cm' .OR.                                             &
3454             var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                &
3455             var(1:16) == 'usm_surfwintrans'  .OR. var(1:7) == 'usm_swc' ) THEN
3456
3457            found = .TRUE.
3458            grid_x = 'x'
3459            grid_y = 'y'
3460            grid_z = 'zu'
3461        ELSE
3462            found  = .FALSE.
3463            grid_x = 'none'
3464            grid_y = 'none'
3465            grid_z = 'none'
3466        ENDIF
3467
3468    END SUBROUTINE usm_define_netcdf_grid
3469   
3470
3471!------------------------------------------------------------------------------!
3472! Description:
3473! ------------
3474!> Initialization of the wall surface model
3475!------------------------------------------------------------------------------!
3476    SUBROUTINE usm_init_material_model
3477
3478        IMPLICIT NONE
3479
3480        INTEGER(iwp) ::  k, l, m            !< running indices
3481       
3482        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'start' )
3483
3484!
3485!--     Calculate wall grid spacings.
3486!--     Temperature is defined at the center of the wall layers,
3487!--     whereas gradients/fluxes are defined at the edges (_stag)     
3488!--     apply for all particular surface grids. First for horizontal surfaces
3489        DO  m = 1, surf_usm_h%ns
3490
3491           surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
3492           DO k = nzb_wall+1, nzt_wall
3493               surf_usm_h%dz_wall(k,m) = surf_usm_h%zw(k,m) -                  &
3494                                         surf_usm_h%zw(k-1,m)
3495           ENDDO
3496           surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
3497           DO k = nzb_wall+1, nzt_wall
3498               surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) -         &
3499                                         surf_usm_h%zw_window(k-1,m)
3500           ENDDO
3501           
3502           surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
3503
3504           DO k = nzb_wall, nzt_wall-1
3505               surf_usm_h%dz_wall_stag(k,m) = 0.5 * (                          &
3506                           surf_usm_h%dz_wall(k+1,m) + surf_usm_h%dz_wall(k,m) )
3507           ENDDO
3508           surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
3509           
3510           surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
3511
3512           DO k = nzb_wall, nzt_wall-1
3513               surf_usm_h%dz_window_stag(k,m) = 0.5 * (                        &
3514                           surf_usm_h%dz_window(k+1,m) + surf_usm_h%dz_window(k,m) )
3515           ENDDO
3516           surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
3517
3518           IF (surf_usm_h%green_type_roof(m) == 2.0_wp ) THEN
3519!
3520!-- extensive green roof
3521!-- set ratio of substrate layer thickness, soil-type and LAI
3522              soil_type = 3
3523              surf_usm_h%lai(m) = 2.0_wp
3524             
3525              surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3526              surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3527              surf_usm_h%zw_green(nzb_wall+2,m) = 0.15_wp
3528              surf_usm_h%zw_green(nzb_wall+3,m) = 0.20_wp
3529           ELSE
3530!
3531!-- intensiv green roof
3532!-- set ratio of substrate layer thickness, soil-type and LAI
3533              soil_type = 6
3534              surf_usm_h%lai(m) = 4.0_wp
3535             
3536              surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3537              surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3538              surf_usm_h%zw_green(nzb_wall+2,m) = 0.40_wp
3539              surf_usm_h%zw_green(nzb_wall+3,m) = 0.80_wp
3540           ENDIF
3541           
3542           surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
3543           DO k = nzb_wall+1, nzt_wall
3544               surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) -           &
3545                                         surf_usm_h%zw_green(k-1,m)
3546           ENDDO
3547           surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
3548
3549           DO k = nzb_wall, nzt_wall-1
3550               surf_usm_h%dz_green_stag(k,m) = 0.5 * (                         &
3551                           surf_usm_h%dz_green(k+1,m) + surf_usm_h%dz_green(k,m) )
3552           ENDDO
3553           surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
3554           
3555          IF ( alpha_vangenuchten == 9999999.9_wp )  THEN
3556             alpha_vangenuchten = soil_pars(0,soil_type)
3557          ENDIF
3558
3559          IF ( l_vangenuchten == 9999999.9_wp )  THEN
3560             l_vangenuchten = soil_pars(1,soil_type)
3561          ENDIF
3562
3563          IF ( n_vangenuchten == 9999999.9_wp )  THEN
3564             n_vangenuchten = soil_pars(2,soil_type)           
3565          ENDIF
3566
3567          IF ( hydraulic_conductivity == 9999999.9_wp )  THEN
3568             hydraulic_conductivity = soil_pars(3,soil_type)           
3569          ENDIF
3570
3571          IF ( saturation_moisture == 9999999.9_wp )  THEN
3572             saturation_moisture = m_soil_pars(0,soil_type)           
3573          ENDIF
3574
3575          IF ( field_capacity == 9999999.9_wp )  THEN
3576             field_capacity = m_soil_pars(1,soil_type)           
3577          ENDIF
3578
3579          IF ( wilting_point == 9999999.9_wp )  THEN
3580             wilting_point = m_soil_pars(2,soil_type)           
3581          ENDIF
3582
3583          IF ( residual_moisture == 9999999.9_wp )  THEN
3584             residual_moisture = m_soil_pars(3,soil_type)       
3585          ENDIF
3586         
3587          DO k = nzb_wall, nzt_wall+1
3588             swc_h(k,m) = field_capacity
3589             rootfr_h(k,m) = 0.5_wp
3590             surf_usm_h%alpha_vg_green(m)      = alpha_vangenuchten
3591             surf_usm_h%l_vg_green(m)          = l_vangenuchten
3592             surf_usm_h%n_vg_green(m)          = n_vangenuchten 
3593             surf_usm_h%gamma_w_green_sat(k,m) = hydraulic_conductivity
3594             swc_sat_h(k,m)                    = saturation_moisture
3595             fc_h(k,m)                         = field_capacity
3596             wilt_h(k,m)                       = wilting_point
3597             swc_res_h(k,m)                    = residual_moisture
3598          ENDDO
3599
3600        ENDDO
3601
3602        surf_usm_h%ddz_wall        = 1.0_wp / surf_usm_h%dz_wall
3603        surf_usm_h%ddz_wall_stag   = 1.0_wp / surf_usm_h%dz_wall_stag
3604        surf_usm_h%ddz_window      = 1.0_wp / surf_usm_h%dz_window
3605        surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
3606        surf_usm_h%ddz_green       = 1.0_wp / surf_usm_h%dz_green
3607        surf_usm_h%ddz_green_stag  = 1.0_wp / surf_usm_h%dz_green_stag
3608!       
3609!--     For vertical surfaces
3610        DO  l = 0, 3
3611           DO  m = 1, surf_usm_v(l)%ns
3612              surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
3613              DO k = nzb_wall+1, nzt_wall
3614                  surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) -         &
3615                                               surf_usm_v(l)%zw(k-1,m)
3616              ENDDO
3617              surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
3618              DO k = nzb_wall+1, nzt_wall
3619                  surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) - &
3620                                               surf_usm_v(l)%zw_window(k-1,m)
3621              ENDDO
3622              surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
3623              DO k = nzb_wall+1, nzt_wall
3624                  surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) - &
3625                                               surf_usm_v(l)%zw_green(k-1,m)
3626              ENDDO
3627           
3628              surf_usm_v(l)%dz_wall(nzt_wall+1,m) =                            &
3629                                              surf_usm_v(l)%dz_wall(nzt_wall,m)
3630
3631              DO k = nzb_wall, nzt_wall-1
3632                  surf_usm_v(l)%dz_wall_stag(k,m) = 0.5 * (                    &
3633                                                surf_usm_v(l)%dz_wall(k+1,m) + &
3634                                                surf_usm_v(l)%dz_wall(k,m) )
3635              ENDDO
3636              surf_usm_v(l)%dz_wall_stag(nzt_wall,m) =                         &
3637                                              surf_usm_v(l)%dz_wall(nzt_wall,m)
3638              surf_usm_v(l)%dz_window(nzt_wall+1,m) =                          &
3639                                              surf_usm_v(l)%dz_window(nzt_wall,m)
3640
3641              DO k = nzb_wall, nzt_wall-1
3642                  surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * (                    &
3643                                                surf_usm_v(l)%dz_window(k+1,m) + &
3644                                                surf_usm_v(l)%dz_window(k,m) )
3645              ENDDO
3646              surf_usm_v(l)%dz_window_stag(nzt_wall,m) =                         &
3647                                              surf_usm_v(l)%dz_window(nzt_wall,m)
3648              surf_usm_v(l)%dz_green(nzt_wall+1,m) =                             &
3649                                              surf_usm_v(l)%dz_green(nzt_wall,m)
3650
3651              DO k = nzb_wall, nzt_wall-1
3652                  surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * (                    &
3653                                                surf_usm_v(l)%dz_green(k+1,m) + &
3654                                                surf_usm_v(l)%dz_green(k,m) )
3655              ENDDO
3656              surf_usm_v(l)%dz_green_stag(nzt_wall,m) =                         &
3657                                              surf_usm_v(l)%dz_green(nzt_wall,m)
3658           ENDDO
3659           surf_usm_v(l)%ddz_wall        = 1.0_wp / surf_usm_v(l)%dz_wall
3660           surf_usm_v(l)%ddz_wall_stag   = 1.0_wp / surf_usm_v(l)%dz_wall_stag
3661           surf_usm_v(l)%ddz_window      = 1.0_wp / surf_usm_v(l)%dz_window
3662           surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
3663           surf_usm_v(l)%ddz_green       = 1.0_wp / surf_usm_v(l)%dz_green
3664           surf_usm_v(l)%ddz_green_stag  = 1.0_wp / surf_usm_v(l)%dz_green_stag
3665        ENDDO     
3666
3667       
3668        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'end' )
3669
3670    END SUBROUTINE usm_init_material_model
3671
3672 
3673!------------------------------------------------------------------------------!
3674! Description:
3675! ------------
3676!> Initialization of the urban surface model
3677!------------------------------------------------------------------------------!
3678    SUBROUTINE usm_init
3679
3680        USE arrays_3d,                                                         &
3681            ONLY:  zw
3682
3683        USE netcdf_data_input_mod,                                             &
3684            ONLY:  building_pars_f, building_type_f, terrain_height_f
3685   
3686        IMPLICIT NONE
3687
3688        INTEGER(iwp) ::  i                   !< loop index x-dirction
3689        INTEGER(iwp) ::  ind_alb_green       !< index in input list for green albedo
3690        INTEGER(iwp) ::  ind_alb_wall        !< index in input list for wall albedo
3691        INTEGER(iwp) ::  ind_alb_win         !< index in input list for window albedo
3692        INTEGER(iwp) ::  ind_emis_wall       !< index in input list for wall emissivity
3693        INTEGER(iwp) ::  ind_emis_green      !< index in input list for green emissivity
3694        INTEGER(iwp) ::  ind_emis_win        !< index in input list for window emissivity
3695        INTEGER(iwp) ::  ind_green_frac_w    !< index in input list for green fraction on wall
3696        INTEGER(iwp) ::  ind_green_frac_r    !< index in input list for green fraction on roof
3697        INTEGER(iwp) ::  ind_hc1             !< index in input list for heat capacity at first wall layer
3698        INTEGER(iwp) ::  ind_hc1_win         !< index in input list for heat capacity at first window layer
3699        INTEGER(iwp) ::  ind_hc2             !< index in input list for heat capacity at second wall layer
3700        INTEGER(iwp) ::  ind_hc2_win         !< index in input list for heat capacity at second window layer
3701        INTEGER(iwp) ::  ind_hc3             !< index in input list for heat capacity at third wall layer
3702        INTEGER(iwp) ::  ind_hc3_win         !< index in input list for heat capacity at third window layer
3703        INTEGER(iwp) ::  ind_lai_r           !< index in input list for LAI on roof
3704        INTEGER(iwp) ::  ind_lai_w           !< index in input list for LAI on wall
3705        INTEGER(iwp) ::  ind_tc1             !< index in input list for thermal conductivity at first wall layer
3706        INTEGER(iwp) ::  ind_tc1_win         !< index in input list for thermal conductivity at first window layer
3707        INTEGER(iwp) ::  ind_tc2             !< index in input list for thermal conductivity at second wall layer
3708        INTEGER(iwp) ::  ind_tc2_win         !< index in input list for thermal conductivity at second window layer
3709        INTEGER(iwp) ::  ind_tc3             !< index in input list for thermal conductivity at third wall layer
3710        INTEGER(iwp) ::  ind_tc3_win         !< index in input list for thermal conductivity at third window layer
3711        INTEGER(iwp) ::  ind_thick_1         !< index in input list for thickness of first wall layer
3712        INTEGER(iwp) ::  ind_thick_1_win     !< index in input list for thickness of first window layer
3713        INTEGER(iwp) ::  ind_thick_2         !< index in input list for thickness of second wall layer
3714        INTEGER(iwp) ::  ind_thick_2_win     !< index in input list for thickness of second window layer
3715        INTEGER(iwp) ::  ind_thick_3         !< index in input list for thickness of third wall layer
3716        INTEGER(iwp) ::  ind_thick_3_win     !< index in input list for thickness of third window layer
3717        INTEGER(iwp) ::  ind_thick_4         !< index in input list for thickness of fourth wall layer
3718        INTEGER(iwp) ::  ind_thick_4_win     !< index in input list for thickness of fourth window layer
3719        INTEGER(iwp) ::  ind_trans           !< index in input list for window transmissivity
3720        INTEGER(iwp) ::  ind_wall_frac       !< index in input list for wall fraction
3721        INTEGER(iwp) ::  ind_win_frac        !< index in input list for window fraction
3722        INTEGER(iwp) ::  ind_z0              !< index in input list for z0
3723        INTEGER(iwp) ::  ind_z0qh            !< index in input list for z0h / z0q
3724        INTEGER(iwp) ::  j                   !< loop index y-dirction
3725        INTEGER(iwp) ::  k                   !< loop index z-dirction
3726        INTEGER(iwp) ::  l                   !< loop index surface orientation
3727        INTEGER(iwp) ::  m                   !< loop index surface element
3728        INTEGER(iwp) ::  st                  !< dummy 
3729
3730        REAL(wp)     ::  c, tin, twin
3731        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
3732        REAL(wp)     ::  z_agl                        !< height above ground
3733
3734        IF ( debug_output )  CALL debug_message( 'usm_init', 'start' )
3735
3736        CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
3737!
3738!--     Initialize building-surface properties
3739        CALL usm_define_pars
3740!
3741!--     surface forcing have to be disabled for LSF
3742!--     in case of enabled urban surface module
3743        IF ( large_scale_forcing )  THEN
3744            lsf_surf = .FALSE.
3745        ENDIF
3746
3747!
3748!--     Flag surface elements belonging to the ground floor level. Therefore,
3749!--     use terrain height array from file, if available. This flag is later used
3750!--     to control initialization of surface attributes.
3751!--     Todo: for the moment disable initialization of building roofs with
3752!--     ground-floor-level properties.
3753        surf_usm_h%ground_level = .FALSE. 
3754
3755        DO  l = 0, 3
3756           surf_usm_v(l)%ground_level = .FALSE.
3757           DO  m = 1, surf_usm_v(l)%ns
3758              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
3759              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
3760              k = surf_usm_v(l)%k(m)
3761!
3762!--           Determine local ground level. Level 1 - default value,
3763!--           level 2 - initialization according to building type,
3764!--           level 3 - initialization from value read from file.
3765              ground_floor_level_l = ground_floor_level
3766             
3767              IF ( building_type_f%from_file )  THEN
3768                  ground_floor_level_l =                                       &
3769                              building_pars(ind_gflh,building_type_f%var(j,i))
3770              ENDIF
3771             
3772              IF ( building_pars_f%from_file )  THEN
3773                 IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=                 &
3774                      building_pars_f%fill )                                   &
3775                    ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
3776              ENDIF
3777!
3778!--           Determine height of surface element above ground level. Please
3779!--           note, height of surface element is determined with respect to
3780!--           its height above ground of the reference grid point in atmosphere,
3781!--           Therefore, substract the offset values when assessing the terrain
3782!--           height.
3783              IF ( terrain_height_f%from_file )  THEN
3784                 z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff,    &
3785                                                      i-surf_usm_v(l)%ioff)
3786              ELSE
3787                 z_agl = zw(k)
3788              ENDIF
3789!
3790!--           Set flag for ground level
3791              IF ( z_agl <= ground_floor_level_l )                             &
3792                 surf_usm_v(l)%ground_level(m) = .TRUE.
3793
3794           ENDDO
3795        ENDDO
3796!
3797!--     Initialization of resistances.
3798        DO  m = 1, surf_usm_h%ns
3799           surf_usm_h%r_a(m)        = 50.0_wp
3800           surf_usm_h%r_a_green(m)  = 50.0_wp
3801           surf_usm_h%r_a_window(m) = 50.0_wp
3802        ENDDO
3803        DO  l = 0, 3
3804           DO  m = 1, surf_usm_v(l)%ns
3805              surf_usm_v(l)%r_a(m)        = 50.0_wp
3806              surf_usm_v(l)%r_a_green(m)  = 50.0_wp
3807              surf_usm_v(l)%r_a_window(m) = 50.0_wp
3808           ENDDO
3809        ENDDO
3810       
3811!
3812!--    Map values onto horizontal elemements
3813       DO  m = 1, surf_usm_h%ns
3814             surf_usm_h%r_canopy_min(m)     = 200.0_wp !< min_canopy_resistance
3815             surf_usm_h%g_d(m)              = 0.0_wp   !< canopy_resistance_coefficient
3816       ENDDO
3817!
3818!--    Map values onto vertical elements, even though this does not make
3819!--    much sense.
3820       DO  l = 0, 3
3821          DO  m = 1, surf_usm_v(l)%ns
3822                surf_usm_v(l)%r_canopy_min(m)     = 200.0_wp !< min_canopy_resistance
3823                surf_usm_v(l)%g_d(m)              = 0.0_wp   !< canopy_resistance_coefficient
3824          ENDDO
3825       ENDDO
3826
3827!
3828!--     Initialize urban-type surface attribute. According to initialization in
3829!--     land-surface model, follow a 3-level approach.
3830!--     Level 1 - initialization via default attributes
3831        DO  m = 1, surf_usm_h%ns
3832!
3833!--        Now, all horizontal surfaces are roof surfaces (?)
3834           surf_usm_h%isroof_surf(m)   = .TRUE.
3835           surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
3836!
3837!--        In order to distinguish between ground floor level and
3838!--        above-ground-floor level surfaces, set input indices.
3839
3840           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3841                                     surf_usm_h%ground_level(m) )
3842           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
3843                                     surf_usm_h%ground_level(m) )
3844           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
3845                                     surf_usm_h%ground_level(m) )
3846           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
3847                                     surf_usm_h%ground_level(m) )
3848!
3849!--        Store building type and its name on each surface element
3850           surf_usm_h%building_type(m)      = building_type
3851           surf_usm_h%building_type_name(m) = building_type_name(building_type)
3852!
3853!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
3854           surf_usm_h%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac_r,building_type)   
3855           surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,building_type) 
3856           surf_usm_h%frac(ind_wat_win,m)   = building_pars(ind_win_frac_r,building_type) 
3857           surf_usm_h%lai(m)                = building_pars(ind_lai_r,building_type) 
3858
3859           surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,building_type) 
3860           surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1_wall_r,building_type)
3861           surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2_wall_r,building_type)
3862           surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3_wall_r,building_type)   
3863           surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1_wall_r,building_type) 
3864           surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1_wall_r,building_type) 
3865           surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2_wall_r,building_type)
3866           surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3_wall_r,building_type)   
3867           surf_usm_h%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1_wall_r,building_type) 
3868           surf_usm_h%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
3869           surf_usm_h%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2_wall_r,building_type)
3870           surf_usm_h%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3_wall_r,building_type)   
3871           surf_usm_h%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type) 
3872           surf_usm_h%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
3873           surf_usm_h%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,building_type)
3874           surf_usm_h%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,building_type)
3875           surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win_r,building_type) 
3876           surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win_r,building_type)
3877           surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win_r,building_type)
3878           surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win_r,building_type)   
3879           surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,building_type) 
3880           surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,building_type) 
3881           surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,building_type)
3882           surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,building_type)   
3883
3884           surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)   
3885           surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)   
3886!
3887!--        emissivity of wall-, green- and window fraction
3888           surf_usm_h%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall_r,building_type)
3889           surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green_r,building_type)
3890           surf_usm_h%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win_r,building_type)
3891
3892           surf_usm_h%transmissivity(m)      = building_pars(ind_trans_r,building_type)
3893
3894           surf_usm_h%z0(m)                  = building_pars(ind_z0,building_type)
3895           surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,building_type)
3896           surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,building_type)
3897!
3898!--        albedo type for wall fraction, green fraction, window fraction
3899           surf_usm_h%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall_r,building_type)  )
3900           surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green_r,building_type) )
3901           surf_usm_h%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win_r,building_type)   )
3902
3903           surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3904           surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3905           surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3906           surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3907           
3908           surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3909           surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3910           surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3911           surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3912           
3913           surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,building_type)
3914           surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,building_type)
3915           surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,building_type)
3916           surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,building_type)
3917
3918           surf_usm_h%c_surface(m)           = building_pars(ind_c_surface,building_type) 
3919           surf_usm_h%lambda_surf(m)         = building_pars(ind_lambda_surf,building_type) 
3920           surf_usm_h%c_surface_green(m)     = building_pars(ind_c_surface_green,building_type) 
3921           surf_usm_h%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,building_type) 
3922           surf_usm_h%c_surface_window(m)    = building_pars(ind_c_surface_win,building_type) 
3923           surf_usm_h%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,building_type) 
3924           
3925           surf_usm_h%green_type_roof(m)     = building_pars(ind_green_type_roof,building_type)
3926
3927        ENDDO
3928
3929        DO  l = 0, 3
3930           DO  m = 1, surf_usm_v(l)%ns
3931
3932              surf_usm_v(l)%surface_types(m) = wall_category         !< default category for root surface
3933!
3934!--           In order to distinguish between ground floor level and
3935!--           above-ground-floor level surfaces, set input indices.
3936              ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,    &
3937                                        surf_usm_v(l)%ground_level(m) )
3938              ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,     &
3939                                        surf_usm_v(l)%ground_level(m) )
3940              ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,      &
3941                                        surf_usm_v(l)%ground_level(m) )
3942              ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
3943                                        surf_usm_v(l)%ground_level(m) )
3944              ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
3945                                        surf_usm_v(l)%ground_level(m) )
3946              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
3947                                        surf_usm_v(l)%ground_level(m) )
3948              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3949                                        surf_usm_v(l)%ground_level(m) )
3950              ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
3951                                        surf_usm_v(l)%ground_level(m) )
3952              ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
3953                                        surf_usm_v(l)%ground_level(m) )
3954              ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
3955                                        surf_usm_v(l)%ground_level(m) )
3956              ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,      &
3957                                        surf_usm_v(l)%ground_level(m) )
3958              ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
3959                                        surf_usm_v(l)%ground_level(m) )
3960              ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,      &
3961                                        surf_usm_v(l)%ground_level(m) )
3962              ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
3963                                        surf_usm_v(l)%ground_level(m) )
3964              ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,      &
3965                                        surf_usm_v(l)%ground_level(m) )
3966              ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
3967                                        surf_usm_v(l)%ground_level(m) )
3968              ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,      &
3969                                        surf_usm_v(l)%ground_level(m) )
3970              ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
3971                                        surf_usm_v(l)%ground_level(m) )
3972              ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,      &
3973                                        surf_usm_v(l)%ground_level(m) )
3974              ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
3975                                        surf_usm_v(l)%ground_level(m) )
3976              ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,      &
3977                                        surf_usm_v(l)%ground_level(m) )
3978              ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,      &
3979                                        surf_usm_v(l)%ground_level(m) )
3980              ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,  &
3981                                        surf_usm_v(l)%ground_level(m) )
3982              ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,      &
3983                                        surf_usm_v(l)%ground_level(m) )
3984              ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,  &
3985                                        surf_usm_v(l)%ground_level(m) )
3986              ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,      &
3987                                        surf_usm_v(l)%ground_level(m) )
3988              ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,  &
3989                                        surf_usm_v(l)%ground_level(m) )
3990              ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,      &
3991                                        surf_usm_v(l)%ground_level(m) )
3992              ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,  &
3993                                        surf_usm_v(l)%ground_level(m) )
3994              ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
3995                                        surf_usm_v(l)%ground_level(m) )
3996              ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
3997                                        surf_usm_v(l)%ground_level(m) )
3998              ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
3999                                        surf_usm_v(l)%ground_level(m) )
4000              ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
4001                                        surf_usm_v(l)%ground_level(m) )
4002              ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4003                                        surf_usm_v(l)%ground_level(m) )
4004              ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4005                                        surf_usm_v(l)%ground_level(m) )
4006!
4007!--           Store building type and its name on each surface element
4008              surf_usm_v(l)%building_type(m)      = building_type
4009              surf_usm_v(l)%building_type_name(m) = building_type_name(building_type)
4010!
4011!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
4012              surf_usm_v(l)%frac(ind_veg_wall,m)   = building_pars(ind_wall_frac,building_type)   
4013              surf_usm_v(l)%frac(ind_pav_green,m)  = building_pars(ind_green_frac_w,building_type) 
4014              surf_usm_v(l)%frac(ind_wat_win,m)    = building_pars(ind_win_frac,building_type) 
4015              surf_usm_v(l)%lai(m)                 = building_pars(ind_lai_w,building_type) 
4016
4017              surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
4018              surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
4019              surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
4020              surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
4021             
4022              surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,building_type) 
4023              surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,building_type)
4024              surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,building_type)
4025              surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,building_type)   
4026             
4027              surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,building_type) 
4028              surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,building_type)
4029              surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,building_type)
4030              surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,building_type)   
4031
4032              surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
4033              surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
4034              surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
4035              surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
4036             
4037              surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,building_type) 
4038              surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,building_type)
4039              surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,building_type)
4040              surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,building_type)   
4041
4042              surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,building_type) 
4043              surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,building_type) 
4044              surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,building_type)
4045              surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,building_type)   
4046
4047              surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)   
4048              surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)   
4049!
4050!--           emissivity of wall-, green- and window fraction
4051              surf_usm_v(l)%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall,building_type)
4052              surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,building_type)
4053              surf_usm_v(l)%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win,building_type)
4054
4055              surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,building_type)
4056
4057              surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,building_type)
4058              surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,building_type)
4059              surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,building_type)
4060
4061              surf_usm_v(l)%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall,building_type) )
4062              surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,building_type) )
4063              surf_usm_v(l)%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win,building_type) )
4064
4065              surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
4066              surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
4067              surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
4068              surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
4069             
4070              surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
4071              surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
4072              surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
4073              surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
4074
4075              surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win,building_type)
4076              surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win,building_type)
4077              surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win,building_type)
4078              surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win,building_type)
4079
4080              surf_usm_v(l)%c_surface(m)           = building_pars(ind_c_surface,building_type) 
4081              surf_usm_v(l)%lambda_surf(m)         = building_pars(ind_lambda_surf,building_type)
4082              surf_usm_v(l)%c_surface_green(m)     = building_pars(ind_c_surface_green,building_type) 
4083              surf_usm_v(l)%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,building_type)
4084              surf_usm_v(l)%c_surface_window(m)    = building_pars(ind_c_surface_win,building_type) 
4085              surf_usm_v(l)%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,building_type)
4086
4087           ENDDO
4088        ENDDO
4089!
4090!--     Level 2 - initialization via building type read from file
4091        IF ( building_type_f%from_file )  THEN
4092           DO  m = 1, surf_usm_h%ns
4093              i = surf_usm_h%i(m)
4094              j = surf_usm_h%j(m)
4095!
4096!--           For the moment, limit building type to 6 (to overcome errors in input file).
4097              st = building_type_f%var(j,i)
4098              IF ( st /= building_type_f%fill )  THEN
4099
4100!
4101!--              In order to distinguish between ground floor level and
4102!--              above-ground-floor level surfaces, set input indices.
4103
4104                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4105                                           surf_usm_h%ground_level(m) )
4106                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
4107                                           surf_usm_h%ground_level(m) )
4108                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4109                                           surf_usm_h%ground_level(m) )
4110                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4111                                           surf_usm_h%ground_level(m) )
4112!
4113!--              Store building type and its name on each surface element
4114                 surf_usm_h%building_type(m)      = st
4115                 surf_usm_h%building_type_name(m) = building_type_name(st)
4116!
4117!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
4118                 surf_usm_h%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac_r,st)   
4119                 surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,st) 
4120                 surf_usm_h%frac(ind_wat_win,m)   = building_pars(ind_win_frac_r,st) 
4121                 surf_usm_h%lai(m)                = building_pars(ind_lai_r,st) 
4122
4123                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,st) 
4124                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1_wall_r,st)
4125                 surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2_wall_r,st)
4126                 surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3_wall_r,st)   
4127                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1_wall_r,st) 
4128                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1_wall_r,st) 
4129                 surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2_wall_r,st)
4130                 surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3_wall_r,st)   
4131                 
4132                 surf_usm_h%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1_wall_r,st) 
4133                 surf_usm_h%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1_wall_r,st)
4134                 surf_usm_h%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2_wall_r,st)
4135                 surf_usm_h%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3_wall_r,st)   
4136                 surf_usm_h%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st) 
4137                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
4138                 surf_usm_h%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,st)
4139                 surf_usm_h%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,st)   
4140               
4141                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win_r,st) 
4142                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win_r,st)
4143                 surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win_r,st)
4144                 surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win_r,st)   
4145                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,st) 
4146                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,st) 
4147                 surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,st)
4148                 surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,st)   
4149
4150                 surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)   
4151                 surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)   
4152!
4153!--              emissivity of wall-, green- and window fraction
4154                 surf_usm_h%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall_r,st)
4155                 surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green_r,st)
4156                 surf_usm_h%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win_r,st)
4157
4158                 surf_usm_h%transmissivity(m)      = building_pars(ind_trans_r,st)
4159
4160                 surf_usm_h%z0(m)                  = building_pars(ind_z0,st)
4161                 surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,st)
4162                 surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
4163!
4164!--              albedo type for wall fraction, green fraction, window fraction
4165                 surf_usm_h%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall_r,st) )
4166                 surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green_r,st) )
4167                 surf_usm_h%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win_r,st) )
4168
4169                 surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,st)
4170                 surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,st)
4171                 surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,st)
4172                 surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,st)
4173                 
4174                 surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,st)
4175                 surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,st)
4176                 surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,st)
4177                 surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,st)
4178
4179                 surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,st)
4180                 surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,st)
4181                 surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,st)
4182                 surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,st)
4183
4184                 surf_usm_h%c_surface(m)           = building_pars(ind_c_surface,st) 
4185                 surf_usm_h%lambda_surf(m)         = building_pars(ind_lambda_surf,st)
4186                 surf_usm_h%c_surface_green(m)     = building_pars(ind_c_surface_green,st) 
4187                 surf_usm_h%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,st)
4188                 surf_usm_h%c_surface_window(m)    = building_pars(ind_c_surface_win,st) 
4189                 surf_usm_h%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,st)
4190                 
4191                 surf_usm_h%green_type_roof(m)     = building_pars(ind_green_type_roof,st)
4192
4193              ENDIF
4194           ENDDO
4195
4196           DO  l = 0, 3
4197              DO  m = 1, surf_usm_v(l)%ns
4198                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4199                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4200!
4201!--              For the moment, limit building type to 6 (to overcome errors in input file).
4202
4203                 st = building_type_f%var(j,i)
4204                 IF ( st /= building_type_f%fill )  THEN
4205
4206!
4207!--                 In order to distinguish between ground floor level and
4208!--                 above-ground-floor level surfaces, set input indices.
4209                    ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,    &
4210                                              surf_usm_v(l)%ground_level(m) )
4211                    ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,     &
4212                                              surf_usm_v(l)%ground_level(m) )
4213                    ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,      &
4214                                              surf_usm_v(l)%ground_level(m) )
4215                    ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
4216                                              surf_usm_v(l)%ground_level(m) )
4217                    ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
4218                                              surf_usm_v(l)%ground_level(m) )
4219                    ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
4220                                              surf_usm_v(l)%ground_level(m) )
4221                    ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4222                                              surf_usm_v(l)%ground_level(m) )
4223                    ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
4224                                              surf_usm_v(l)%ground_level(m) )
4225                    ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
4226                                              surf_usm_v(l)%ground_level(m) )
4227                    ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
4228                                              surf_usm_v(l)%ground_level(m) )
4229                    ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,      &
4230                                              surf_usm_v(l)%ground_level(m) )
4231                    ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
4232                                              surf_usm_v(l)%ground_level(m) )
4233                    ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,      &
4234                                              surf_usm_v(l)%ground_level(m) )
4235                    ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
4236                                              surf_usm_v(l)%ground_level(m) )
4237                    ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,      &
4238                                              surf_usm_v(l)%ground_level(m) )
4239                    ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
4240                                              surf_usm_v(l)%ground_level(m) )
4241                    ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,      &
4242                                              surf_usm_v(l)%ground_level(m) )
4243                    ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
4244                                              surf_usm_v(l)%ground_level(m) )
4245                    ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,      &
4246                                              surf_usm_v(l)%ground_level(m) )
4247                    ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
4248                                              surf_usm_v(l)%ground_level(m) )
4249                    ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,      &
4250                                              surf_usm_v(l)%ground_level(m) )
4251                    ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,      &
4252                                              surf_usm_v(l)%ground_level(m) )
4253                    ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,  &
4254                                              surf_usm_v(l)%ground_level(m) )
4255                    ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,      &
4256                                              surf_usm_v(l)%ground_level(m) )
4257                    ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,  &
4258                                              surf_usm_v(l)%ground_level(m) )
4259                    ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,      &
4260                                              surf_usm_v(l)%ground_level(m) )
4261                    ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,  &
4262                                              surf_usm_v(l)%ground_level(m) )
4263                    ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,      &
4264                                              surf_usm_v(l)%ground_level(m) )
4265                    ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,  &
4266                                              surf_usm_v(l)%ground_level(m) )
4267                    ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
4268                                              surf_usm_v(l)%ground_level(m) )
4269                    ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
4270                                              surf_usm_v(l)%ground_level(m) )
4271                    ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
4272                                              surf_usm_v(l)%ground_level(m) )
4273                    ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
4274                                            surf_usm_v(l)%ground_level(m) )
4275                    ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4276                                              surf_usm_v(l)%ground_level(m) )
4277                    ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4278                                              surf_usm_v(l)%ground_level(m) )
4279!
4280!--                 Store building type and its name on each surface element
4281                    surf_usm_v(l)%building_type(m)      = st
4282                    surf_usm_v(l)%building_type_name(m) = building_type_name(st)
4283!
4284!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
4285                    surf_usm_v(l)%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac,st)   
4286                    surf_usm_v(l)%frac(ind_pav_green,m) = building_pars(ind_green_frac_w,st) 
4287                    surf_usm_v(l)%frac(ind_wat_win,m)   = building_pars(ind_win_frac,st)   
4288                    surf_usm_v(l)%lai(m)                = building_pars(ind_lai_w,st) 
4289
4290                    surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st) 
4291                    surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
4292                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
4293                    surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
4294                   
4295                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,st) 
4296                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,st)
4297                    surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,st)
4298                    surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,st)
4299                   
4300                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,st) 
4301                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,st)
4302                    surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,st)
4303                    surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,st)
4304
4305                    surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st) 
4306                    surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st) 
4307                    surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
4308                    surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st) 
4309                   
4310                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,st) 
4311                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,st)
4312                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,st)
4313                    surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,st)
4314                   
4315                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,st) 
4316                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,st) 
4317                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,st)
4318                    surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,st) 
4319
4320                    surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)   
4321                    surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)   
4322!
4323!--                 emissivity of wall-, green- and window fraction
4324                    surf_usm_v(l)%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall,st)
4325                    surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,st)
4326                    surf_usm_v(l)%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win,st)
4327
4328                    surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,st)
4329
4330                    surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,st)
4331                    surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,st)
4332                    surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,st)
4333
4334                    surf_usm_v(l)%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall,st) )
4335                    surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,st) )
4336                    surf_usm_v(l)%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win,st) )
4337
4338                    surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,st)
4339                    surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
4340                    surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
4341                    surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
4342                   
4343                    surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,st)
4344                    surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
4345                    surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
4346                    surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
4347                   
4348                    surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win,st)
4349                    surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win,st)
4350                    surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win,st)
4351                    surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win,st)
4352
4353                    surf_usm_v(l)%c_surface(m)           = building_pars(ind_c_surface,st) 
4354                    surf_usm_v(l)%lambda_surf(m)         = building_pars(ind_lambda_surf,st) 
4355                    surf_usm_v(l)%c_surface_green(m)     = building_pars(ind_c_surface_green,st) 
4356                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,st) 
4357                    surf_usm_v(l)%c_surface_window(m)    = building_pars(ind_c_surface_win,st) 
4358                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,st) 
4359
4360
4361                 ENDIF
4362              ENDDO
4363           ENDDO
4364        ENDIF 
4365       
4366!
4367!--     Level 3 - initialization via building_pars read from file. Note, only
4368!--     variables that are also defined in the input-standard can be initialized
4369!--     via file. Other variables will be initialized on level 1 or 2.
4370        IF ( building_pars_f%from_file )  THEN
4371           DO  m = 1, surf_usm_h%ns
4372              i = surf_usm_h%i(m)
4373              j = surf_usm_h%j(m)
4374
4375!
4376!--           In order to distinguish between ground floor level and
4377!--           above-ground-floor level surfaces, set input indices.
4378              ind_wall_frac    = MERGE( ind_wall_frac_gfl,                     &
4379                                        ind_wall_frac_agfl,                    &
4380                                        surf_usm_h%ground_level(m) )
4381              ind_green_frac_r = MERGE( ind_green_frac_r_gfl,                  &
4382                                        ind_green_frac_r_agfl,                 &
4383                                        surf_usm_h%ground_level(m) )
4384              ind_win_frac     = MERGE( ind_win_frac_gfl,                      &
4385                                        ind_win_frac_agfl,                     &
4386                                        surf_usm_h%ground_level(m) )
4387              ind_lai_r        = MERGE( ind_lai_r_gfl,                         &
4388                                        ind_lai_r_agfl,                        &
4389                                        surf_usm_h%ground_level(m) )
4390              ind_z0           = MERGE( ind_z0_gfl,                            &
4391                                        ind_z0_agfl,                           &
4392                                        surf_usm_h%ground_level(m) )
4393              ind_z0qh         = MERGE( ind_z0qh_gfl,                          &
4394                                        ind_z0qh_agfl,                         &
4395                                        surf_usm_h%ground_level(m) )
4396              ind_hc1          = MERGE( ind_hc1_gfl,                           &
4397                                        ind_hc1_agfl,                          &
4398                                        surf_usm_h%ground_level(m) )
4399              ind_hc2          = MERGE( ind_hc2_gfl,                           &
4400                                        ind_hc2_agfl,                          &
4401                                        surf_usm_h%ground_level(m) )
4402              ind_hc3          = MERGE( ind_hc3_gfl,                           &
4403                                        ind_hc3_agfl,                          &
4404                                        surf_usm_h%ground_level(m) )
4405              ind_tc1          = MERGE( ind_tc1_gfl,                           &
4406                                        ind_tc1_agfl,                          &
4407                                        surf_usm_h%ground_level(m) )
4408              ind_tc2          = MERGE( ind_tc2_gfl,                           &
4409                                        ind_tc2_agfl,                          &
4410                                        surf_usm_h%ground_level(m) )
4411              ind_tc3          = MERGE( ind_tc3_gfl,                           &
4412                                        ind_tc3_agfl,                          &
4413                                        surf_usm_h%ground_level(m) )
4414              ind_emis_wall    = MERGE( ind_emis_wall_gfl,                     &
4415                                        ind_emis_wall_agfl,                    &
4416                                        surf_usm_h%ground_level(m) )
4417              ind_emis_green   = MERGE( ind_emis_green_gfl,                    &
4418                                        ind_emis_green_agfl,                   &
4419                                        surf_usm_h%ground_level(m) )
4420              ind_emis_win     = MERGE( ind_emis_win_gfl,                      &
4421                                        ind_emis_win_agfl,                     &
4422                                        surf_usm_h%ground_level(m) )
4423              ind_trans        = MERGE( ind_trans_gfl,                         &
4424                                        ind_trans_agfl,                        &
4425                                        surf_usm_h%ground_level(m) )
4426
4427!
4428!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
4429              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /=               &
4430                   building_pars_f%fill )                                      &
4431                 surf_usm_h%frac(ind_veg_wall,m)  =                            &
4432                                    building_pars_f%pars_xy(ind_wall_frac,j,i)   
4433                 
4434              IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /=            &         
4435                   building_pars_f%fill )                                      & 
4436                 surf_usm_h%frac(ind_pav_green,m) =                            &
4437                                    building_pars_f%pars_xy(ind_green_frac_r,j,i) 
4438                 
4439              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /=                &
4440                   building_pars_f%fill )                                      & 
4441                 surf_usm_h%frac(ind_wat_win,m)   =                            &
4442                                    building_pars_f%pars_xy(ind_win_frac,j,i)
4443 
4444              IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /=                   &
4445                   building_pars_f%fill )                                      &
4446                 surf_usm_h%lai(m)  = building_pars_f%pars_xy(ind_lai_r,j,i)
4447
4448              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4449                   building_pars_f%fill )  THEN
4450                 surf_usm_h%rho_c_wall(nzb_wall,m)   =                         &
4451                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4452                 surf_usm_h%rho_c_wall(nzb_wall+1,m) =                         &
4453                                    building_pars_f%pars_xy(ind_hc1,j,i)
4454              ENDIF
4455             
4456             
4457              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4458                   building_pars_f%fill )                                      &
4459                 surf_usm_h%rho_c_wall(nzb_wall+2,m) =                         &
4460                                    building_pars_f%pars_xy(ind_hc2,j,i)
4461                 
4462              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4463                   building_pars_f%fill )                                      &
4464                 surf_usm_h%rho_c_wall(nzb_wall+3,m) =                         &
4465                                    building_pars_f%pars_xy(ind_hc3,j,i)
4466                 
4467              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4468                   building_pars_f%fill )  THEN
4469                 surf_usm_h%rho_c_green(nzb_wall,m)   =                        &
4470                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4471                 surf_usm_h%rho_c_green(nzb_wall+1,m) =                        &
4472                                    building_pars_f%pars_xy(ind_hc1,j,i)
4473              ENDIF
4474              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4475                   building_pars_f%fill )                                      &
4476                 surf_usm_h%rho_c_green(nzb_wall+2,m) =                        &
4477                                    building_pars_f%pars_xy(ind_hc2,j,i)
4478                 
4479              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4480                   building_pars_f%fill )                                      &
4481                 surf_usm_h%rho_c_green(nzb_wall+3,m) =                        &
4482                                    building_pars_f%pars_xy(ind_hc3,j,i)
4483                 
4484              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4485                   building_pars_f%fill )  THEN
4486                 surf_usm_h%rho_c_window(nzb_wall,m)   =                       &
4487                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4488                 surf_usm_h%rho_c_window(nzb_wall+1,m) =                       &
4489                                    building_pars_f%pars_xy(ind_hc1,j,i)
4490              ENDIF
4491              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4492                   building_pars_f%fill )                                      &
4493                 surf_usm_h%rho_c_window(nzb_wall+2,m) =                       &
4494                                    building_pars_f%pars_xy(ind_hc2,j,i)
4495                 
4496              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4497                   building_pars_f%fill )                                      &
4498                 surf_usm_h%rho_c_window(nzb_wall+3,m) =                       &
4499                                    building_pars_f%pars_xy(ind_hc3,j,i)
4500
4501              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=                     &
4502                   building_pars_f%fill )  THEN
4503                 surf_usm_h%lambda_h(nzb_wall,m)   =                           &
4504                                    building_pars_f%pars_xy(ind_tc1,j,i)         
4505                 surf_usm_h%lambda_h(nzb_wall+1,m) =                           &
4506                                    building_pars_f%pars_xy(ind_tc1,j,i)       
4507              ENDIF
4508              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     & 
4509                   building_pars_f%fill )                                      &
4510                 surf_usm_h%lambda_h(nzb_wall+2,m) =                           &
4511                                    building_pars_f%pars_xy(ind_tc2,j,i)
4512                 
4513              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &
4514                   building_pars_f%fill )                                      & 
4515                 surf_usm_h%lambda_h(nzb_wall+3,m) =                           &
4516                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4517                 
4518              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=                     &
4519                   building_pars_f%fill )  THEN
4520                 surf_usm_h%lambda_h_green(nzb_wall,m)   =                     &
4521                                     building_pars_f%pars_xy(ind_tc1,j,i)         
4522                 surf_usm_h%lambda_h_green(nzb_wall+1,m) =                     &
4523                                     building_pars_f%pars_xy(ind_tc1,j,i)       
4524              ENDIF
4525              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     & 
4526                   building_pars_f%fill )                                      &
4527                 surf_usm_h%lambda_h_green(nzb_wall+2,m) =                     &
4528                                    building_pars_f%pars_xy(ind_tc2,j,i)
4529                 
4530              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &       
4531                   building_pars_f%fill )                                      &
4532                 surf_usm_h%lambda_h_green(nzb_wall+3,m) =                     &
4533                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4534                 
4535              IF ( building_pars_f%pars_xy(ind_tc1_win_r,j,i) /=               &
4536                   building_pars_f%fill )  THEN
4537                 surf_usm_h%lambda_h_window(nzb_wall,m)   =                    &
4538                                     building_pars_f%pars_xy(ind_tc1_win_r,j,i)         
4539                 surf_usm_h%lambda_h_window(nzb_wall+1,m) =                    &
4540                                     building_pars_f%pars_xy(ind_tc1_win_r,j,i)       
4541              ENDIF
4542              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     &     
4543                   building_pars_f%fill )                                      &
4544                 surf_usm_h%lambda_h_window(nzb_wall+2,m) =                    &
4545                                     building_pars_f%pars_xy(ind_tc2,j,i)
4546                 
4547              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &   
4548                   building_pars_f%fill )                                      &
4549                 surf_usm_h%lambda_h_window(nzb_wall+3,m) =                    &
4550                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4551
4552              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=&           
4553                   building_pars_f%fill )                                      & 
4554                 surf_usm_h%target_temp_summer(m)  =                           &
4555                      building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)   
4556              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=&           
4557                   building_pars_f%fill )                                      & 
4558                 surf_usm_h%target_temp_winter(m)  =                           &
4559                      building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)   
4560
4561              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /=               &   
4562                   building_pars_f%fill )                                      &
4563                 surf_usm_h%emissivity(ind_veg_wall,m)  =                      &
4564                                    building_pars_f%pars_xy(ind_emis_wall,j,i)
4565                 
4566              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /=              &           
4567                   building_pars_f%fill )                                      &
4568                 surf_usm_h%emissivity(ind_pav_green,m) =                      &
4569                                     building_pars_f%pars_xy(ind_emis_green,j,i)
4570                 
4571              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /=                & 
4572                   building_pars_f%fill )                                      &
4573                 surf_usm_h%emissivity(ind_wat_win,m)   =                      &
4574                                     building_pars_f%pars_xy(ind_emis_win,j,i)
4575                 
4576              IF ( building_pars_f%pars_xy(ind_trans,j,i) /=                   &   
4577                   building_pars_f%fill )                                      &
4578                 surf_usm_h%transmissivity(m) =                                &
4579                                    building_pars_f%pars_xy(ind_trans,j,i)
4580
4581              IF ( building_pars_f%pars_xy(ind_z0,j,i) /=                      &         
4582                   building_pars_f%fill )                                      &
4583                 surf_usm_h%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4584                 
4585              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=                    &           
4586                   building_pars_f%fill )                                      &
4587                 surf_usm_h%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4588              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=                    &           
4589                   building_pars_f%fill )                                      &
4590                 surf_usm_h%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4591
4592              IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /=           &         
4593                   building_pars_f%fill )                                      & 
4594                 surf_usm_h%albedo_type(ind_veg_wall,m)  =                     &
4595                                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4596                 
4597              IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /=          &           
4598                   building_pars_f%fill )                                      &
4599                 surf_usm_h%albedo_type(ind_pav_green,m) =                     &
4600                                building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4601              IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /=            &         
4602                   building_pars_f%fill )                                      &
4603                 surf_usm_h%albedo_type(ind_wat_win,m)   =                     &
4604                                   building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4605
4606              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=            &         
4607                   building_pars_f%fill )                                      & 
4608                 surf_usm_h%zw(nzb_wall,m) =                                   &
4609                                  building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4610                 
4611              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=            &         
4612                   building_pars_f%fill )                                      &
4613                 surf_usm_h%zw(nzb_wall+1,m) =                                 &
4614                                  building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4615                 
4616              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=            &         
4617                   building_pars_f%fill )                                      &
4618                 surf_usm_h%zw(nzb_wall+2,m) =                                 &
4619                                  building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4620                 
4621                 
4622              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=            &         
4623                   building_pars_f%fill )                                      & 
4624                 surf_usm_h%zw(nzb_wall+3,m) =                                 &
4625                                  building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4626                 
4627              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=            &           
4628                   building_pars_f%fill )                                      &
4629                 surf_usm_h%zw_green(nzb_wall,m) =                             &
4630                                  building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4631                 
4632              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=            &         
4633                   building_pars_f%fill )                                      &
4634                 surf_usm_h%zw_green(nzb_wall+1,m) =                           &
4635                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4636                 
4637              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=            &         
4638                   building_pars_f%fill )                                      & 
4639                 surf_usm_h%zw_green(nzb_wall+2,m) =                           &
4640                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4641                 
4642              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=            &         
4643                   building_pars_f%fill )                                      &
4644                 surf_usm_h%zw_green(nzb_wall+3,m) =                           &
4645                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4646
4647              IF ( building_pars_f%pars_xy(ind_c_surface,j,i) /=               &       
4648                   building_pars_f%fill )                                      & 
4649                 surf_usm_h%c_surface(m) =                                     &
4650                                    building_pars_f%pars_xy(ind_c_surface,j,i)
4651                 
4652              IF ( building_pars_f%pars_xy(ind_lambda_surf,j,i) /=             &       
4653                   building_pars_f%fill )                                      &
4654                 surf_usm_h%lambda_surf(m) =                                   &
4655                                    building_pars_f%pars_xy(ind_lambda_surf,j,i)
4656             
4657           ENDDO
4658
4659
4660
4661           DO  l = 0, 3
4662              DO  m = 1, surf_usm_v(l)%ns
4663                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4664                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4665               
4666!
4667!--                 In order to distinguish between ground floor level and
4668!--                 above-ground-floor level surfaces, set input indices.
4669                    ind_wall_frac    = MERGE( ind_wall_frac_gfl,               &
4670                                              ind_wall_frac_agfl,              &
4671                                              surf_usm_v(l)%ground_level(m) )
4672                    ind_green_frac_w = MERGE( ind_green_frac_w_gfl,            &
4673                                              ind_green_frac_w_agfl,           &
4674                                              surf_usm_v(l)%ground_level(m) )
4675                    ind_win_frac     = MERGE( ind_win_frac_gfl,                &
4676                                              ind_win_frac_agfl,               &
4677                                              surf_usm_v(l)%ground_level(m) )
4678                    ind_lai_w        = MERGE( ind_lai_w_gfl,                   &
4679                                              ind_lai_w_agfl,                  &
4680                                              surf_usm_v(l)%ground_level(m) )
4681                    ind_z0           = MERGE( ind_z0_gfl,                      &
4682                                              ind_z0_agfl,                     &
4683                                              surf_usm_v(l)%ground_level(m) )
4684                    ind_z0qh         = MERGE( ind_z0qh_gfl,                    &
4685                                              ind_z0qh_agfl,                   &
4686                                              surf_usm_v(l)%ground_level(m) )
4687                    ind_hc1          = MERGE( ind_hc1_gfl,                     &
4688                                              ind_hc1_agfl,                    &
4689                                              surf_usm_v(l)%ground_level(m) )
4690                    ind_hc2          = MERGE( ind_hc2_gfl,                     &
4691                                              ind_hc2_agfl,                    &
4692                                              surf_usm_v(l)%ground_level(m) )
4693                    ind_hc3          = MERGE( ind_hc3_gfl,                     &
4694                                              ind_hc3_agfl,                    &
4695                                              surf_usm_v(l)%ground_level(m) )
4696                    ind_tc1          = MERGE( ind_tc1_gfl,                     &
4697                                              ind_tc1_agfl,                    &
4698                                              surf_usm_v(l)%ground_level(m) )
4699                    ind_tc2          = MERGE( ind_tc2_gfl,                     &
4700                                              ind_tc2_agfl,                    &
4701                                              surf_usm_v(l)%ground_level(m) )
4702                    ind_tc3          = MERGE( ind_tc3_gfl,                     &
4703                                              ind_tc3_agfl,                    &
4704                                              surf_usm_v(l)%ground_level(m) )
4705                    ind_emis_wall    = MERGE( ind_emis_wall_gfl,               &
4706                                              ind_emis_wall_agfl,              &
4707                                              surf_usm_v(l)%ground_level(m) )
4708                    ind_emis_green   = MERGE( ind_emis_green_gfl,              &
4709                                              ind_emis_green_agfl,             &
4710                                              surf_usm_v(l)%ground_level(m) )
4711                    ind_emis_win     = MERGE( ind_emis_win_gfl,                &
4712                                              ind_emis_win_agfl,               &
4713                                              surf_usm_v(l)%ground_level(m) )
4714                    ind_trans        = MERGE( ind_trans_gfl,                   &
4715                                              ind_trans_agfl,                  &
4716                                              surf_usm_v(l)%ground_level(m) )
4717                   
4718!                   
4719!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
4720                    IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /=         &
4721                         building_pars_f%fill )                                &
4722                       surf_usm_v(l)%frac(ind_veg_wall,m)  =                   &
4723                                          building_pars_f%pars_xy(ind_wall_frac,j,i)   
4724                       
4725                    IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /=      &         
4726                         building_pars_f%fill )                                & 
4727                       surf_usm_v(l)%frac(ind_pav_green,m) =                   &
4728                                  building_pars_f%pars_xy(ind_green_frac_w,j,i) 
4729                       
4730                    IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /=          &
4731                         building_pars_f%fill )                                & 
4732                       surf_usm_v(l)%frac(ind_wat_win,m)   =                   &
4733                                       building_pars_f%pars_xy(ind_win_frac,j,i)
4734                   
4735                    IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /=             &
4736                         building_pars_f%fill )                                &
4737                       surf_usm_v(l)%lai(m)  =                                 &
4738                                       building_pars_f%pars_xy(ind_lai_w,j,i)
4739                   
4740                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4741                         building_pars_f%fill )  THEN
4742                       surf_usm_v(l)%rho_c_wall(nzb_wall,m)   =                &
4743                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4744                       surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) =                &
4745                                          building_pars_f%pars_xy(ind_hc1,j,i)
4746                    ENDIF
4747                   
4748                   
4749                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4750                         building_pars_f%fill )                                &
4751                       surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) =                &
4752                                          building_pars_f%pars_xy(ind_hc2,j,i)
4753                       
4754                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &         
4755                         building_pars_f%fill )                                &
4756                       surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) =                &
4757                                          building_pars_f%pars_xy(ind_hc3,j,i)
4758                       
4759                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4760                         building_pars_f%fill )  THEN
4761                       surf_usm_v(l)%rho_c_green(nzb_wall,m)   =               &
4762                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4763                       surf_usm_v(l)%rho_c_green(nzb_wall+1,m) =               &
4764                                          building_pars_f%pars_xy(ind_hc1,j,i)
4765                    ENDIF
4766                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4767                         building_pars_f%fill )                                &
4768                       surf_usm_v(l)%rho_c_green(nzb_wall+2,m) =               &
4769                                          building_pars_f%pars_xy(ind_hc2,j,i)
4770                       
4771                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &
4772                         building_pars_f%fill )                                &
4773                       surf_usm_v(l)%rho_c_green(nzb_wall+3,m) =               &
4774                                          building_pars_f%pars_xy(ind_hc3,j,i)
4775                       
4776                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4777                         building_pars_f%fill )  THEN
4778                       surf_usm_v(l)%rho_c_window(nzb_wall,m)   =              &
4779                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4780                       surf_usm_v(l)%rho_c_window(nzb_wall+1,m) =              &
4781                                          building_pars_f%pars_xy(ind_hc1,j,i)
4782                    ENDIF
4783                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4784                         building_pars_f%fill )                                &
4785                       surf_usm_v(l)%rho_c_window(nzb_wall+2,m) =              &
4786                                          building_pars_f%pars_xy(ind_hc2,j,i)
4787                       
4788                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &
4789                         building_pars_f%fill )                                &
4790                       surf_usm_v(l)%rho_c_window(nzb_wall+3,m) =              &
4791                                          building_pars_f%pars_xy(ind_hc3,j,i)
4792                   
4793                    IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=               &
4794                         building_pars_f%fill )  THEN
4795                       surf_usm_v(l)%lambda_h(nzb_wall,m)   =                  &
4796                                          building_pars_f%pars_xy(ind_tc1,j,i)   
4797                       surf_usm_v(l)%lambda_h(nzb_wall+1,m) =                  &
4798                                          building_pars_f%pars_xy(ind_tc1,j,i) 
4799                    ENDIF
4800                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               & 
4801                         building_pars_f%fill )                                &
4802                       surf_usm_v(l)%lambda_h(nzb_wall+2,m) =                  &
4803                                          building_pars_f%pars_xy(ind_tc2,j,i)
4804                       
4805                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &
4806                         building_pars_f%fill )                                & 
4807                       surf_usm_v(l)%lambda_h(nzb_wall+3,m) =                  &
4808                                          building_pars_f%pars_xy(ind_tc3,j,i) 
4809                       
4810                    IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=               &
4811                         building_pars_f%fill )  THEN
4812                       surf_usm_v(l)%lambda_h_green(nzb_wall,m)   =            &
4813                                           building_pars_f%pars_xy(ind_tc1,j,i)   
4814                       surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) =            &
4815                                           building_pars_f%pars_xy(ind_tc1,j,i) 
4816                    ENDIF
4817                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               & 
4818                         building_pars_f%fill )                                &
4819                       surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) =            &
4820                                          building_pars_f%pars_xy(ind_tc2,j,i)
4821                       
4822                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &       
4823                         building_pars_f%fill )                                &
4824                       surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) =            &
4825                                          building_pars_f%pars_xy(ind_tc3,j,i) 
4826                       
4827                    IF ( building_pars_f%pars_xy(ind_tc1_win_r,j,i) /=         &
4828                         building_pars_f%fill )  THEN
4829                       surf_usm_v(l)%lambda_h_window(nzb_wall,m)   =           &
4830                                     building_pars_f%pars_xy(ind_tc1_win_r,j,i)         
4831                       surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) =           &
4832                                     building_pars_f%pars_xy(ind_tc1_win_r,j,i)       
4833                    ENDIF
4834                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               &     
4835                         building_pars_f%fill )                                &
4836                       surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) =           &
4837                                           building_pars_f%pars_xy(ind_tc2,j,i)
4838                       
4839                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &   
4840                         building_pars_f%fill )                                &
4841                       surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) =           &
4842                                          building_pars_f%pars_xy(ind_tc3,j,i)   
4843                   
4844                    IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=&           
4845                         building_pars_f%fill )                                & 
4846                       surf_usm_v(l)%target_temp_summer(m)  =                  &
4847                            building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)   
4848                    IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=&           
4849                         building_pars_f%fill )                                & 
4850                       surf_usm_v(l)%target_temp_winter(m)  =                  &
4851                            building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)   
4852                   
4853                    IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /=         &   
4854                         building_pars_f%fill )                                &
4855                       surf_usm_v(l)%emissivity(ind_veg_wall,m)  =             &
4856                                      building_pars_f%pars_xy(ind_emis_wall,j,i)
4857                       
4858                    IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /=        &           
4859                         building_pars_f%fill )                                &
4860                       surf_usm_v(l)%emissivity(ind_pav_green,m) =             &
4861                                      building_pars_f%pars_xy(ind_emis_green,j,i)
4862                       
4863                    IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /=          & 
4864                         building_pars_f%fill )                                &
4865                       surf_usm_v(l)%emissivity(ind_wat_win,m)   =             &
4866                                      building_pars_f%pars_xy(ind_emis_win,j,i)
4867                       
4868                    IF ( building_pars_f%pars_xy(ind_trans,j,i) /=             &   
4869                         building_pars_f%fill )                                &
4870                       surf_usm_v(l)%transmissivity(m) =                       &
4871                                          building_pars_f%pars_xy(ind_trans,j,i)
4872                   
4873                    IF ( building_pars_f%pars_xy(ind_z0,j,i) /=                &         
4874                         building_pars_f%fill )                                &
4875                       surf_usm_v(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4876                       
4877                    IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=              &           
4878                         building_pars_f%fill )                                &
4879                       surf_usm_v(l)%z0h(m) =                                  &
4880                                       building_pars_f%pars_xy(ind_z0qh,j,i)
4881                    IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=              &           
4882                         building_pars_f%fill )                                &
4883                       surf_usm_v(l)%z0q(m) =                                  &
4884                                       building_pars_f%pars_xy(ind_z0qh,j,i)
4885                   
4886                    IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /=     &         
4887                         building_pars_f%fill )                                & 
4888                       surf_usm_v(l)%albedo_type(ind_veg_wall,m)  =            &
4889                                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4890                       
4891                    IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /=    &           
4892                         building_pars_f%fill )                                &
4893                       surf_usm_v(l)%albedo_type(ind_pav_green,m) =            &
4894                                 building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4895                    IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /=      &         
4896                         building_pars_f%fill )                                &
4897                       surf_usm_v(l)%albedo_type(ind_wat_win,m)   =            &
4898                                   building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4899                   
4900                    IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=      &         
4901                         building_pars_f%fill )                                & 
4902                       surf_usm_v(l)%zw(nzb_wall,m) =                          &
4903                                   building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4904                       
4905                    IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=      &         
4906                         building_pars_f%fill )                                &
4907                       surf_usm_v(l)%zw(nzb_wall+1,m) =                        &
4908                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4909                       
4910                    IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=      &         
4911                         building_pars_f%fill )                                &
4912                       surf_usm_v(l)%zw(nzb_wall+2,m) =                        &
4913                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4914                       
4915                       
4916                    IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=      &         
4917                         building_pars_f%fill )                                & 
4918                       surf_usm_v(l)%zw(nzb_wall+3,m) =                        &
4919                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4920                       
4921                    IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=      &           
4922                         building_pars_f%fill )                                &
4923                       surf_usm_v(l)%zw_green(nzb_wall,m) =                    &
4924                                   building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4925                       
4926                    IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=      &         
4927                         building_pars_f%fill )                                &
4928                       surf_usm_v(l)%zw_green(nzb_wall+1,m) =                  &
4929                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4930                       
4931                    IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=      &         
4932                         building_pars_f%fill )                                & 
4933                       surf_usm_v(l)%zw_green(nzb_wall+2,m) =                  &
4934                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4935                       
4936                    IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=      &         
4937                         building_pars_f%fill )                                &
4938                       surf_usm_v(l)%zw_green(nzb_wall+3,m) =                  &
4939                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4940                   
4941                    IF ( building_pars_f%pars_xy(ind_c_surface,j,i) /=         &       
4942                         building_pars_f%fill )                                & 
4943                       surf_usm_v(l)%c_surface(m) =                            &
4944                                     building_pars_f%pars_xy(ind_c_surface,j,i)
4945                       
4946                    IF ( building_pars_f%pars_xy(ind_lambda_surf,j,i) /=       &       
4947                         building_pars_f%fill )                                &
4948                       surf_usm_v(l)%lambda_surf(m) =                          &
4949                                    building_pars_f%pars_xy(ind_lambda_surf,j,i)
4950                   
4951              ENDDO
4952           ENDDO
4953        ENDIF 
4954!       
4955!--     Read the surface_types array.
4956!--     Please note, here also initialization of surface attributes is done as
4957!--     long as _urbsurf and _surfpar files are available. Values from above
4958!--     will be overwritten. This might be removed later, but is still in the
4959!--     code to enable compatibility with older model version.
4960        CALL usm_read_urban_surface_types()
4961       
4962        CALL usm_init_material_model()
4963!       
4964!--     init anthropogenic sources of heat
4965        IF ( usm_anthropogenic_heat )  THEN
4966!
4967!--         init anthropogenic sources of heat (from transportation for now)
4968            CALL usm_read_anthropogenic_heat()
4969        ENDIF
4970
4971!
4972!--    Check for consistent initialization.
4973!--    Check if roughness length for momentum, or heat, exceed surface-layer
4974!--    height and decrease local roughness length where necessary.
4975       DO  m = 1, surf_usm_h%ns
4976          IF ( surf_usm_h%z0(m) >= surf_usm_h%z_mo(m) )  THEN
4977         
4978             surf_usm_h%z0(m) = 0.9_wp * surf_usm_h%z_mo(m)
4979             
4980             WRITE( message_string, * ) 'z0 exceeds surface-layer height ' //  &
4981                            'at horizontal urban surface and is ' //           &
4982                            'decreased appropriately at grid point (i,j) = ',  &
4983                            surf_usm_h%i(m), surf_usm_h%j(m)
4984             CALL message( 'urban_surface_model_mod', 'PA0503',                &
4985                            0, 0, 0, 6, 0 )
4986          ENDIF
4987          IF ( surf_usm_h%z0h(m) >= surf_usm_h%z_mo(m) )  THEN
4988         
4989             surf_usm_h%z0h(m) = 0.9_wp * surf_usm_h%z_mo(m)
4990             surf_usm_h%z0q(m) = 0.9_wp * surf_usm_h%z_mo(m)
4991             
4992             WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // &
4993                            'at horizontal urban surface and is ' //           &
4994                            'decreased appropriately at grid point (i,j) = ',  &
4995                            surf_usm_h%i(m), surf_usm_h%j(m)
4996             CALL message( 'urban_surface_model_mod', 'PA0507',                &
4997                            0, 0, 0, 6, 0 )
4998          ENDIF         
4999       ENDDO
5000       
5001       DO  l = 0, 3
5002          DO  m = 1, surf_usm_v(l)%ns
5003             IF ( surf_usm_v(l)%z0(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5004         
5005                surf_usm_v(l)%z0(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5006             
5007                WRITE( message_string, * ) 'z0 exceeds surface-layer height '// &
5008                            'at vertical urban surface and is ' //              &
5009                            'decreased appropriately at grid point (i,j) = ',   &
5010                            surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,              &
5011                            surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5012                CALL message( 'urban_surface_model_mod', 'PA0503',              &
5013                            0, 0, 0, 6, 0 )
5014             ENDIF
5015             IF ( surf_usm_v(l)%z0h(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5016         
5017                surf_usm_v(l)%z0h(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5018                surf_usm_v(l)%z0q(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5019             
5020                WRITE( message_string, * ) 'z0h exceeds surface-layer height '// &
5021                            'at vertical urban surface and is ' //               &
5022                            'decreased appropriately at grid point (i,j) = ',    &
5023                            surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,               &
5024                            surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5025                CALL message( 'urban_surface_model_mod', 'PA0507',               &
5026                            0, 0, 0, 6, 0 )
5027             ENDIF
5028          ENDDO
5029       ENDDO
5030
5031!
5032!--     Intitialization of the surface and wall/ground/roof temperature
5033!
5034!--     Initialization for restart runs
5035        IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.        &
5036             TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
5037
5038!
5039!--         At horizontal surfaces. Please note, t_surf_wall_h is defined on a
5040!--         different data type, but with the same dimension.
5041            DO  m = 1, surf_usm_h%ns
5042               i = surf_usm_h%i(m)           
5043               j = surf_usm_h%j(m)
5044               k = surf_usm_h%k(m)
5045
5046               t_surf_wall_h(m) = pt(k,j,i) * exner(k)
5047               t_surf_window_h(m) = pt(k,j,i) * exner(k)
5048               t_surf_green_h(m) = pt(k,j,i) * exner(k)
5049               surf_usm_h%pt_surface(m) = pt(k,j,i) * exner(k)
5050            ENDDO
5051!
5052!--         At vertical surfaces.
5053            DO  l = 0, 3
5054               DO  m = 1, surf_usm_v(l)%ns
5055                  i = surf_usm_v(l)%i(m)           
5056                  j = surf_usm_v(l)%j(m)
5057                  k = surf_usm_v(l)%k(m)
5058
5059                  t_surf_wall_v(l)%t(m) = pt(k,j,i) * exner(k)
5060                  t_surf_window_v(l)%t(m) = pt(k,j,i) * exner(k)
5061                  t_surf_green_v(l)%t(m) = pt(k,j,i) * exner(k)
5062                  surf_usm_v(l)%pt_surface(m) = pt(k,j,i) * exner(k)
5063               ENDDO
5064            ENDDO
5065
5066!
5067!--         For the sake of correct initialization, set also q_surface.
5068!--         Note, at urban surfaces q_surface is initialized with 0.
5069            IF ( humidity )  THEN
5070               DO  m = 1, surf_usm_h%ns
5071                  surf_usm_h%q_surface(m) = 0.0_wp
5072               ENDDO
5073               DO  l = 0, 3
5074                  DO  m = 1, surf_usm_v(l)%ns
5075                     surf_usm_v(l)%q_surface(m) = 0.0_wp
5076                  ENDDO
5077               ENDDO
5078            ENDIF
5079!
5080!--         initial values for t_wall
5081!--         outer value is set to surface temperature
5082!--         inner value is set to wall_inner_temperature
5083!--         and profile is logaritmic (linear in nz).
5084!--         Horizontal surfaces
5085            DO  m = 1, surf_usm_h%ns
5086!
5087!--            Roof
5088               IF ( surf_usm_h%isroof_surf(m) )  THEN
5089                   tin = roof_inner_temperature
5090                   twin = window_inner_temperature
5091!
5092!--            Normal land surface
5093               ELSE
5094                   tin = soil_inner_temperature
5095                   twin = window_inner_temperature
5096               ENDIF
5097
5098               DO k = nzb_wall, nzt_wall+1
5099                   c = REAL( k - nzb_wall, wp ) /                              &
5100                       REAL( nzt_wall + 1 - nzb_wall , wp )
5101
5102                   t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_wall_h(m) + c * tin
5103                   t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
5104                   t_green_h(k,m) = t_surf_wall_h(m)
5105                   swc_h(k,m) = 0.5_wp
5106                   swc_sat_h(k,m) = 0.95_wp
5107                   swc_res_h(k,m) = 0.05_wp
5108                   rootfr_h(k,m) = 0.1_wp
5109                   wilt_h(k,m) = 0.1_wp
5110                   fc_h(k,m) = 0.9_wp
5111               ENDDO
5112            ENDDO
5113!
5114!--         Vertical surfaces
5115            DO  l = 0, 3
5116               DO  m = 1, surf_usm_v(l)%ns
5117!
5118!--               Inner wall
5119                  tin = wall_inner_temperature
5120                  twin = window_inner_temperature
5121
5122                  DO k = nzb_wall, nzt_wall+1
5123                     c = REAL( k - nzb_wall, wp ) /                            &
5124                         REAL( nzt_wall + 1 - nzb_wall , wp )
5125                     t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_wall_v(l)%t(m) + c * tin
5126                     t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
5127                     t_green_v(l)%t(k,m) = t_surf_wall_v(l)%t(m)
5128                     swc_v(l)%t(k,m) = 0.5_wp
5129                  ENDDO
5130               ENDDO
5131            ENDDO
5132        ENDIF
5133
5134!
5135!--     If specified, replace constant wall temperatures with fully 3D values from file
5136        IF ( read_wall_temp_3d )  CALL usm_read_wall_temperature()
5137
5138!--
5139!--     Possibly DO user-defined actions (e.g. define heterogeneous wall surface)
5140        CALL user_init_urban_surface
5141
5142!
5143!--     initialize prognostic values for the first timestep
5144        t_surf_wall_h_p = t_surf_wall_h
5145        t_surf_wall_v_p = t_surf_wall_v
5146        t_surf_window_h_p = t_surf_window_h
5147        t_surf_window_v_p = t_surf_window_v
5148        t_surf_green_h_p = t_surf_green_h
5149        t_surf_green_v_p = t_surf_green_v
5150
5151        t_wall_h_p = t_wall_h
5152        t_wall_v_p = t_wall_v
5153        t_window_h_p = t_window_h
5154        t_window_v_p = t_window_v
5155        t_green_h_p = t_green_h
5156        t_green_v_p = t_green_v
5157
5158!
5159!--     Adjust radiative fluxes for urban surface at model start
5160        !CALL radiation_interaction
5161!--     TODO: interaction should be called once before first output,
5162!--     that is not yet possible.
5163       
5164        m_liq_usm_h_p     = m_liq_usm_h
5165        m_liq_usm_v_p     = m_liq_usm_v
5166!
5167!--    Set initial values for prognostic quantities
5168!--    Horizontal surfaces
5169       tm_liq_usm_h_m%var_usm_1d  = 0.0_wp
5170       surf_usm_h%c_liq = 0.0_wp
5171
5172       surf_usm_h%qsws_liq  = 0.0_wp
5173       surf_usm_h%qsws_veg  = 0.0_wp
5174
5175!
5176!--    Do the same for vertical surfaces
5177       DO  l = 0, 3
5178          tm_liq_usm_v_m(l)%var_usm_1d  = 0.0_wp
5179          surf_usm_v(l)%c_liq = 0.0_wp
5180
5181          surf_usm_v(l)%qsws_liq  = 0.0_wp
5182          surf_usm_v(l)%qsws_veg  = 0.0_wp
5183       ENDDO
5184
5185!
5186!--    Set initial values for prognostic soil quantities
5187       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
5188          m_liq_usm_h%var_usm_1d  = 0.0_wp
5189
5190          DO  l = 0, 3
5191             m_liq_usm_v(l)%var_usm_1d  = 0.0_wp
5192          ENDDO
5193       ENDIF
5194
5195        CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
5196
5197        IF ( debug_output )  CALL debug_message( 'usm_init', 'end' )
5198
5199    END SUBROUTINE usm_init
5200
5201
5202!------------------------------------------------------------------------------!
5203! Description:
5204! ------------
5205!
5206!> Wall model as part of the urban surface model. The model predicts vertical
5207!> and horizontal wall / roof temperatures and window layer temperatures.
5208!> No window layer temperature calculactions during spinup to increase
5209!> possible timestep.
5210!------------------------------------------------------------------------------!
5211    SUBROUTINE usm_material_heat_model( spinup )
5212
5213
5214        IMPLICIT NONE
5215
5216        INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
5217
5218        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend, wintend  !< tendency
5219        REAL(wp)     :: win_absorp  !< absorption coefficient from transmissivity
5220        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wall_mod
5221
5222        LOGICAL      :: spinup  !< if true, no calculation of window temperatures
5223
5224
5225        IF ( debug_output )  THEN
5226           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
5227           CALL debug_message( debug_string, 'start' )
5228        ENDIF
5229
5230        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
5231        wall_mod=1.0_wp
5232        IF (usm_wall_mod .AND. spinup) THEN
5233           DO  kw=nzb_wall,nzb_wall+1
5234               wall_mod(kw)=0.1_wp
5235           ENDDO
5236        ENDIF
5237
5238!
5239!--     For horizontal surfaces                                   
5240        !$OMP DO SCHEDULE (STATIC)
5241        DO  m = 1, surf_usm_h%ns
5242!
5243!--        Obtain indices
5244           i = surf_usm_h%i(m)           
5245           j = surf_usm_h%j(m)
5246           k = surf_usm_h%k(m)
5247!
5248!--        prognostic equation for ground/roof temperature t_wall_h
5249           wtend(:) = 0.0_wp
5250           wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *        &
5251                                       ( surf_usm_h%lambda_h(nzb_wall,m) * wall_mod(nzb_wall) *        &
5252                                         ( t_wall_h(nzb_wall+1,m)                  &
5253                                         - t_wall_h(nzb_wall,m) ) *                &
5254                                         surf_usm_h%ddz_wall(nzb_wall+1,m)         &
5255                                       + surf_usm_h%frac(ind_veg_wall,m)           &
5256                                         / (surf_usm_h%frac(ind_veg_wall,m)        &
5257                                           + surf_usm_h%frac(ind_pav_green,m) )    &
5258                                         * surf_usm_h%wghf_eb(m)                   &
5259                                       - surf_usm_h%frac(ind_pav_green,m)          &
5260                                          / (surf_usm_h%frac(ind_veg_wall,m)       &
5261                                            + surf_usm_h%frac(ind_pav_green,m) )   &
5262                                         * ( surf_usm_h%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) &
5263                                           * surf_usm_h%ddz_green(nzt_wall,m)      &
5264                                           + surf_usm_h%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)      &
5265                                           * surf_usm_h%ddz_wall(nzb_wall,m) )     &
5266                                         / ( surf_usm_h%ddz_green(nzt_wall,m)      &
5267                                           + surf_usm_h%ddz_wall(nzb_wall,m) )     &
5268                                         * ( t_wall_h(nzb_wall,m)                  &
5269                                           - t_green_h(nzt_wall,m) ) ) *           &
5270                                       surf_usm_h%ddz_wall_stag(nzb_wall,m)
5271!
5272!-- if indoor model ist used inner wall layer is calculated by using iwghf (indoor wall ground heat flux)
5273           IF ( indoor_model ) THEN
5274              DO  kw = nzb_wall+1, nzt_wall-1
5275                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
5276                                 * (   surf_usm_h%lambda_h(kw,m) * wall_mod(kw)   &
5277                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
5278                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
5279                                 - surf_usm_h%lambda_h(kw-1,m) * wall_mod(kw-1)   &
5280                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
5281                                    * surf_usm_h%ddz_wall(kw,m)                   &
5282                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
5283              ENDDO
5284              wtend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m)) *    &
5285                                         ( -surf_usm_h%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1) * &
5286                                           ( t_wall_h(nzt_wall,m)                 &
5287                                           - t_wall_h(nzt_wall-1,m) ) *           &
5288                                           surf_usm_h%ddz_wall(nzt_wall,m)        &
5289                                         + surf_usm_h%iwghf_eb(m) ) *             &
5290                                           surf_usm_h%ddz_wall_stag(nzt_wall,m)
5291           ELSE
5292              DO  kw = nzb_wall+1, nzt_wall
5293                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
5294                                 * (   surf_usm_h%lambda_h(kw,m)  * wall_mod(kw)  &
5295                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
5296                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
5297                                 - surf_usm_h%lambda_h(kw-1,m) * wall_mod(kw-1)   &
5298                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
5299                                    * surf_usm_h%ddz_wall(kw,m)                   &
5300                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
5301              ENDDO
5302           ENDIF
5303
5304           t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m)     &
5305                                 + dt_3d * ( tsc(2)                            &
5306                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
5307                                 * surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )   
5308
5309!
5310!-- during spinup the tempeature inside window layers is not calculated to make larger timesteps possible
5311           IF ( .NOT. spinup) THEN
5312              win_absorp = -log(surf_usm_h%transmissivity(m)) / surf_usm_h%zw_window(nzt_wall,m)
5313!
5314!--           prognostic equation for ground/roof window temperature t_window_h
5315!--           takes absorption of shortwave radiation into account
5316              wintend(:) = 0.0_wp
5317              wintend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m)) *   &
5318                                         ( surf_usm_h%lambda_h_window(nzb_wall,m) *  &
5319                                           ( t_window_h(nzb_wall+1,m)                &
5320                                           - t_window_h(nzb_wall,m) ) *              &
5321                                           surf_usm_h%ddz_window(nzb_wall+1,m)       &
5322                                         + surf_usm_h%wghf_eb_window(m)              &
5323                                         + surf_usm_h%rad_sw_in(m)                   &
5324                                           * (1.0_wp - exp(-win_absorp               &
5325                                           * surf_usm_h%zw_window(nzb_wall,m) ) )    &
5326                                         ) * surf_usm_h%ddz_window_stag(nzb_wall,m)
5327   
5328              IF ( indoor_model ) THEN
5329                 DO  kw = nzb_wall+1, nzt_wall-1
5330                     wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
5331                                    * (   surf_usm_h%lambda_h_window(kw,m)           &
5332                                       * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
5333                                       * surf_usm_h%ddz_window(kw+1,m)               &
5334                                    - surf_usm_h%lambda_h_window(kw-1,m)             &
5335                                       * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
5336                                       * surf_usm_h%ddz_window(kw,m)                 &
5337                                    + surf_usm_h%rad_sw_in(m)                        &
5338                                       * (exp(-win_absorp                            &
5339                                           * surf_usm_h%zw_window(kw-1,m) )          &
5340                                           - exp(-win_absorp                         &
5341                                           * surf_usm_h%zw_window(kw,m) ) )          &
5342                                      ) * surf_usm_h%ddz_window_stag(kw,m)
5343   
5344                 ENDDO
5345                 wintend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m)) *       &
5346                                            ( -surf_usm_h%lambda_h_window(nzt_wall-1,m) *   &
5347                                              ( t_window_h(nzt_wall,m)                      &
5348                                              - t_window_h(nzt_wall-1,m) ) *                &
5349                                              surf_usm_h%ddz_window(nzt_wall,m)             &
5350                                            + surf_usm_h%iwghf_eb_window(m)                 &
5351                                            + surf_usm_h%rad_sw_in(m)                       &
5352                                              * (exp(-win_absorp                            &
5353                                              * surf_usm_h%zw_window(nzt_wall-1,m) )        &
5354                                              - exp(-win_absorp                             &
5355                                              * surf_usm_h%zw_window(nzt_wall,m) ) )        &
5356                                            ) * surf_usm_h%ddz_window_stag(nzt_wall,m)
5357              ELSE
5358                 DO  kw = nzb_wall+1, nzt_wall
5359                     wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
5360                                    * (   surf_usm_h%lambda_h_window(kw,m)           &
5361                                       * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
5362                                       * surf_usm_h%ddz_window(kw+1,m)               &
5363                                    - surf_usm_h%lambda_h_window(kw-1,m)             &
5364                                       * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
5365                                       * surf_usm_h%ddz_window(kw,m)                 &
5366                                    + surf_usm_h%rad_sw_in(m)                        &
5367                                       * (exp(-win_absorp                            &
5368                                           * surf_usm_h%zw_window(kw-1,m) )          &
5369                                           - exp(-win_absorp                         &
5370                                           * surf_usm_h%zw_window(kw,m) ) )          &
5371                                      ) * surf_usm_h%ddz_window_stag(kw,m)
5372   
5373                 ENDDO
5374              ENDIF
5375
5376              t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m) &
5377                                 + dt_3d * ( tsc(2)                               &
5378                                 * wintend(nzb_wall:nzt_wall) + tsc(3)            &
5379                                 * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )   
5380
5381           ENDIF
5382
5383!
5384!--        calculate t_wall tendencies for the next Runge-Kutta step
5385           IF ( timestep_scheme(1:5) == 'runge' )  THEN
5386               IF ( intermediate_timestep_count == 1 )  THEN
5387                  DO  kw = nzb_wall, nzt_wall
5388                     surf_usm_h%tt_wall_m(kw,m) = wtend(kw)
5389                  ENDDO
5390               ELSEIF ( intermediate_timestep_count <                          &
5391                        intermediate_timestep_count_max )  THEN
5392                   DO  kw = nzb_wall, nzt_wall
5393                      surf_usm_h%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +    &
5394                                         5.3125_wp * surf_usm_h%tt_wall_m(kw,m)
5395                   ENDDO
5396               ENDIF
5397           ENDIF
5398
5399           IF (.NOT. spinup) THEN
5400!
5401!--           calculate t_window tendencies for the next Runge-Kutta step
5402              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5403                  IF ( intermediate_timestep_count == 1 )  THEN
5404                     DO  kw = nzb_wall, nzt_wall
5405                        surf_usm_h%tt_window_m(kw,m) = wintend(kw)
5406                     ENDDO
5407                  ELSEIF ( intermediate_timestep_count <                            &
5408                           intermediate_timestep_count_max )  THEN
5409                      DO  kw = nzb_wall, nzt_wall
5410                         surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +  &
5411                                            5.3125_wp * surf_usm_h%tt_window_m(kw,m)
5412                      ENDDO
5413                  ENDIF
5414              ENDIF
5415           ENDIF
5416
5417        ENDDO
5418
5419!
5420!--     For vertical surfaces     
5421        !$OMP DO SCHEDULE (STATIC)
5422        DO  l = 0, 3                             
5423           DO  m = 1, surf_usm_v(l)%ns
5424!
5425!--           Obtain indices
5426              i = surf_usm_v(l)%i(m)           
5427              j = surf_usm_v(l)%j(m)
5428              k = surf_usm_v(l)%k(m)
5429!
5430!--           prognostic equation for wall temperature t_wall_v
5431              wtend(:) = 0.0_wp
5432
5433              wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) *    &
5434                                      ( surf_usm_v(l)%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)  *      &
5435                                        ( t_wall_v(l)%t(nzb_wall+1,m)                &
5436                                        - t_wall_v(l)%t(nzb_wall,m) ) *              &
5437                                        surf_usm_v(l)%ddz_wall(nzb_wall+1,m)         &
5438                                      + surf_usm_v(l)%frac(ind_veg_wall,m)           &
5439                                        / (surf_usm_v(l)%frac(ind_veg_wall,m)        &
5440                                          + surf_usm_v(l)%frac(ind_pav_green,m) )    &
5441                                        * surf_usm_v(l)%wghf_eb(m)                   &
5442                                      - surf_usm_v(l)%frac(ind_pav_green,m)          &
5443                                        / (surf_usm_v(l)%frac(ind_veg_wall,m)        &
5444                                          + surf_usm_v(l)%frac(ind_pav_green,m) )    &
5445                                        * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) &
5446                                          * surf_usm_v(l)%ddz_green(nzt_wall,m)      &
5447                                          + surf_usm_v(l)%lambda_h(nzb_wall,m)* wall_mod(nzb_wall)       &
5448                                          * surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
5449                                        / ( surf_usm_v(l)%ddz_green(nzt_wall,m)      &
5450                                          + surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
5451                                        * ( t_wall_v(l)%t(nzb_wall,m)                &
5452                                          - t_green_v(l)%t(nzt_wall,m) ) ) *         &
5453                                        surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
5454
5455              IF ( indoor_model ) THEN
5456                 DO  kw = nzb_wall+1, nzt_wall-1
5457                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
5458                              * (   surf_usm_v(l)%lambda_h(kw,m)  * wall_mod(kw)  &
5459                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5460                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
5461                              - surf_usm_v(l)%lambda_h(kw-1,m)  * wall_mod(kw-1)  &
5462                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5463                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
5464                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5465                 ENDDO
5466                 wtend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m)) * &
5467                                         ( -surf_usm_v(l)%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)*    &
5468                                           ( t_wall_v(l)%t(nzt_wall,m)               &
5469                                           - t_wall_v(l)%t(nzt_wall-1,m) ) *         &
5470                                           surf_usm_v(l)%ddz_wall(nzt_wall,m)        &
5471                                         + surf_usm_v(l)%iwghf_eb(m) ) *             &
5472                                           surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
5473              ELSE
5474                 DO  kw = nzb_wall+1, nzt_wall
5475                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
5476                              * (   surf_usm_v(l)%lambda_h(kw,m) * wall_mod(kw)   &
5477                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5478                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
5479                              - surf_usm_v(l)%lambda_h(kw-1,m)  * wall_mod(kw-1)  &
5480                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5481                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
5482                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5483                 ENDDO
5484              ENDIF
5485
5486              t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
5487                                   t_wall_v(l)%t(nzb_wall:nzt_wall,m)          &
5488                                 + dt_3d * ( tsc(2)                            &
5489                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
5490                                 * surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall,m) )   
5491
5492              IF (.NOT. spinup) THEN
5493                 win_absorp = -log(surf_usm_v(l)%transmissivity(m)) / surf_usm_v(l)%zw_window(nzt_wall,m)
5494!
5495!--              prognostic equation for window temperature t_window_v
5496                 wintend(:) = 0.0_wp
5497                 wintend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m)) * &
5498                                         ( surf_usm_v(l)%lambda_h_window(nzb_wall,m) *   &
5499                                           ( t_window_v(l)%t(nzb_wall+1,m)               &
5500                                           - t_window_v(l)%t(nzb_wall,m) ) *             &
5501                                           surf_usm_v(l)%ddz_window(nzb_wall+1,m)        &
5502                                         + surf_usm_v(l)%wghf_eb_window(m)               &
5503                                         + surf_usm_v(l)%rad_sw_in(m)                    &
5504                                           * (1.0_wp - exp(-win_absorp                   &
5505                                           * surf_usm_v(l)%zw_window(nzb_wall,m) ) )     &
5506                                         ) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
5507   
5508                 IF ( indoor_model ) THEN
5509                    DO  kw = nzb_wall+1, nzt_wall -1
5510                        wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
5511                                 * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
5512                                    * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5513                                    * surf_usm_v(l)%ddz_window(kw+1,m)                    &
5514                                 - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
5515                                    * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5516                                    * surf_usm_v(l)%ddz_window(kw,m)                      &
5517                                 + surf_usm_v(l)%rad_sw_in(m)                             &
5518                                    * (exp(-win_absorp                                    &
5519                                       * surf_usm_v(l)%zw_window(kw-1,m)       )          &
5520                                           - exp(-win_absorp                              &
5521                                           * surf_usm_v(l)%zw_window(kw,m) ) )            &
5522                                    ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5523                     ENDDO
5524                     wintend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m)) *  &
5525                                             ( -surf_usm_v(l)%lambda_h_window(nzt_wall-1,m) * &
5526                                               ( t_window_v(l)%t(nzt_wall,m)                  &
5527                                               - t_window_v(l)%t(nzt_wall-1,m) ) *            &
5528                                               surf_usm_v(l)%ddz_window(nzt_wall,m)           &
5529                                             + surf_usm_v(l)%iwghf_eb_window(m)               &
5530                                             + surf_usm_v(l)%rad_sw_in(m)                     &
5531                                               * (exp(-win_absorp                             &
5532                                             * surf_usm_v(l)%zw_window(nzt_wall-1,m) )        &
5533                                           - exp(-win_absorp                                  &
5534                                               * surf_usm_v(l)%zw_window(nzt_wall,m) ) )      &
5535                                             ) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
5536                 ELSE
5537                    DO  kw = nzb_wall+1, nzt_wall
5538                        wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
5539                                 * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
5540                                    * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5541                                    * surf_usm_v(l)%ddz_window(kw+1,m)                    &
5542                                 - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
5543                                    * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5544                                    * surf_usm_v(l)%ddz_window(kw,m)                      &
5545                                 + surf_usm_v(l)%rad_sw_in(m)                             &
5546                                    * (exp(-win_absorp                                    &
5547                                       * surf_usm_v(l)%zw_window(kw-1,m)       )          &
5548                                           - exp(-win_absorp                              &
5549                                           * surf_usm_v(l)%zw_window(kw,m) ) )            &
5550                                    ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5551                    ENDDO
5552                 ENDIF
5553   
5554                 t_window_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
5555                                      t_window_v(l)%t(nzb_wall:nzt_wall,m)          &
5556                                    + dt_3d * ( tsc(2)                              &
5557                                    * wintend(nzb_wall:nzt_wall) + tsc(3)           &
5558                                    * surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )   
5559              ENDIF
5560
5561!
5562!--           calculate t_wall tendencies for the next Runge-Kutta step
5563              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5564                  IF ( intermediate_timestep_count == 1 )  THEN
5565                     DO  kw = nzb_wall, nzt_wall
5566                        surf_usm_v(l)%tt_wall_m(kw,m) = wtend(kw)
5567                     ENDDO
5568                  ELSEIF ( intermediate_timestep_count <                       &
5569                           intermediate_timestep_count_max )  THEN
5570                      DO  kw = nzb_wall, nzt_wall
5571                         surf_usm_v(l)%tt_wall_m(kw,m) =                       &
5572                                     - 9.5625_wp * wtend(kw) +                 &
5573                                       5.3125_wp * surf_usm_v(l)%tt_wall_m(kw,m)
5574                      ENDDO
5575                  ENDIF
5576              ENDIF
5577
5578
5579              IF (.NOT. spinup) THEN
5580!
5581!--              calculate t_window tendencies for the next Runge-Kutta step
5582                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
5583                     IF ( intermediate_timestep_count == 1 )  THEN
5584                        DO  kw = nzb_wall, nzt_wall
5585                           surf_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
5586                        ENDDO
5587                     ELSEIF ( intermediate_timestep_count <                       &
5588                              intermediate_timestep_count_max )  THEN
5589                         DO  kw = nzb_wall, nzt_wall
5590                            surf_usm_v(l)%tt_window_m(kw,m) =                     &
5591                                        - 9.5625_wp * wintend(kw) +               &
5592                                          5.3125_wp * surf_usm_v(l)%tt_window_m(kw,m)
5593                         ENDDO
5594                     ENDIF
5595                 ENDIF
5596              ENDIF
5597
5598           ENDDO
5599        ENDDO
5600        !$OMP END PARALLEL
5601
5602        IF ( debug_output )  THEN
5603           WRITE( debug_string, * ) 'usm_material_heat_model | spinup: ', spinup
5604           CALL debug_message( debug_string, 'end' )
5605        ENDIF
5606
5607    END SUBROUTINE usm_material_heat_model
5608
5609!------------------------------------------------------------------------------!
5610! Description:
5611! ------------
5612!
5613!> Green and substrate model as part of the urban surface model. The model predicts ground
5614!> temperatures.
5615!------------------------------------------------------------------------------!
5616    SUBROUTINE usm_green_heat_model
5617
5618
5619        IMPLICIT NONE
5620
5621        INTEGER(iwp) ::  i,j,k,l,kw, m              !< running indices
5622
5623        REAL(wp)     :: ke, lambda_h_green_sat      !< heat conductivity for saturated soil
5624        REAL(wp)     :: h_vg                        !< Van Genuchten coef. h
5625        REAL(wp)     :: drho_l_lv                   !< frequently used parameter
5626
5627        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: gtend,tend  !< tendency
5628
5629        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: root_extr_green
5630
5631        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) :: lambda_green_temp  !< temp. lambda
5632        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) :: gamma_green_temp   !< temp. gamma
5633
5634        LOGICAL :: conserve_water_content = .true.
5635
5636
5637        IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'start' )
5638
5639        drho_l_lv = 1.0_wp / (rho_l * l_v)
5640
5641!
5642!--     For horizontal surfaces                                   
5643        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend,  &
5644        !$OMP&                  tend, h_vg, gamma_green_temp, m_total, root_extr_green)
5645        !$OMP DO SCHEDULE (STATIC)
5646        DO  m = 1, surf_usm_h%ns
5647
5648           IF (surf_usm_h%frac(ind_pav_green,m) > 0.0_wp) THEN
5649!
5650!--           Obtain indices
5651              i = surf_usm_h%i(m)           
5652              j = surf_usm_h%j(m)
5653              k = surf_usm_h%k(m)
5654   
5655              DO  kw = nzb_wall, nzt_wall
5656!
5657!--              Calculate volumetric heat capacity of the soil, taking
5658!--              into account water content
5659                 surf_usm_h%rho_c_total_green(kw,m) = (surf_usm_h%rho_c_green(kw,m) * (1.0_wp - swc_sat_h(kw,m)) &
5660                                      + rho_c_water * swc_h(kw,m))
5661     
5662!
5663!--              Calculate soil heat conductivity at the center of the soil
5664!--              layers
5665                 lambda_h_green_sat = lambda_h_green_sm ** (1.0_wp - swc_sat_h(kw,m)) *    &
5666                                lambda_h_water ** swc_h(kw,m)
5667     
5668                 ke = 1.0_wp + LOG10(MAX(0.1_wp,swc_h(kw,m)             &
5669                      / swc_sat_h(kw,m)))
5670     
5671                 lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry) +    &
5672                                  lambda_h_green_dry
5673   
5674              ENDDO
5675              lambda_green_temp(nzt_wall+1) = lambda_green_temp(nzt_wall)
5676   
5677   
5678!
5679!--           Calculate soil heat conductivity (lambda_h) at the _stag level
5680!--           using linear interpolation. For pavement surface, the
5681!--           true pavement depth is considered
5682              DO  kw = nzb_wall, nzt_wall
5683                surf_usm_h%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )  &
5684                                      * 0.5_wp
5685              ENDDO
5686
5687              t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
5688!
5689!--        prognostic equation for ground/roof temperature t_green_h
5690              gtend(:) = 0.0_wp
5691              gtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_total_green(nzb_wall,m)) *    &
5692                                         ( surf_usm_h%lambda_h_green(nzb_wall,m) * &
5693                                           ( t_green_h(nzb_wall+1,m)               &
5694                                           - t_green_h(nzb_wall,m) ) *             &
5695                                           surf_usm_h%ddz_green(nzb_wall+1,m)      &
5696                                         + surf_usm_h%wghf_eb_green(m) ) *         &
5697                                           surf_usm_h%ddz_green_stag(nzb_wall,m)
5698             
5699               DO  kw = nzb_wall+1, nzt_wall
5700                   gtend(kw) = (1.0_wp / surf_usm_h%rho_c_total_green(kw,m))       &
5701                                  * (   surf_usm_h%lambda_h_green(kw,m)            &
5702                                     * ( t_green_h(kw+1,m) - t_green_h(kw,m) )     &
5703                                     * surf_usm_h%ddz_green(kw+1,m)                &
5704                                  - surf_usm_h%lambda_h_green(kw-1,m)              &
5705                                     * ( t_green_h(kw,m) - t_green_h(kw-1,m) )     &
5706                                     * surf_usm_h%ddz_green(kw,m)                  &
5707                                    ) * surf_usm_h%ddz_green_stag(kw,m)
5708               ENDDO
5709   
5710              t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m)    &
5711                                    + dt_3d * ( tsc(2)                             &
5712                                    * gtend(nzb_wall:nzt_wall) + tsc(3)            &
5713                                    * surf_usm_h%tt_green_m(nzb_wall:nzt_wall,m) )   
5714   
5715             
5716!
5717!--        calculate t_green tendencies for the next Runge-Kutta step
5718              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5719                  IF ( intermediate_timestep_count == 1 )  THEN
5720                     DO  kw = nzb_wall, nzt_wall
5721                        surf_usm_h%tt_green_m(kw,m) = gtend(kw)
5722                     ENDDO
5723                  ELSEIF ( intermediate_timestep_count <                           &
5724                           intermediate_timestep_count_max )  THEN
5725                      DO  kw = nzb_wall, nzt_wall
5726                         surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) +    &
5727                                            5.3125_wp * surf_usm_h%tt_green_m(kw,m)
5728                      ENDDO
5729                  ENDIF
5730              ENDIF
5731
5732              DO  kw = nzb_wall, nzt_wall
5733
5734!
5735!--              Calculate soil diffusivity at the center of the soil layers
5736                 lambda_green_temp(kw) = (- b_ch * surf_usm_h%gamma_w_green_sat(kw,m) * psi_sat       &
5737                                   / swc_sat_h(kw,m) ) * ( MAX( swc_h(kw,m),    &
5738                                   wilt_h(kw,m) ) / swc_sat_h(kw,m) )**(        &
5739                                   b_ch + 2.0_wp )
5740
5741!
5742!--              Parametrization of Van Genuchten
5743                 IF ( soil_type /= 7 )  THEN
5744!
5745!--                 Calculate the hydraulic conductivity after Van Genuchten
5746!--                 (1980)
5747                    h_vg = ( ( (swc_res_h(kw,m) - swc_sat_h(kw,m)) / ( swc_res_h(kw,m) -    &
5748                               MAX( swc_h(kw,m), wilt_h(kw,m) ) ) )**(      &
5749                               surf_usm_h%n_vg_green(m) / (surf_usm_h%n_vg_green(m) - 1.0_wp ) ) - 1.0_wp  &
5750                           )**( 1.0_wp / surf_usm_h%n_vg_green(m) ) / surf_usm_h%alpha_vg_green(m)
5751
5752
5753                    gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m) * ( ( (1.0_wp +         &
5754                                    ( surf_usm_h%alpha_vg_green(m) * h_vg )**surf_usm_h%n_vg_green(m))**(  &
5755                                    1.0_wp - 1.0_wp / surf_usm_h%n_vg_green(m) ) - (        &
5756                                    surf_usm_h%alpha_vg_green(m) * h_vg )**( surf_usm_h%n_vg_green(m)      &
5757                                    - 1.0_wp) )**2 )                         &
5758                                    / ( ( 1.0_wp + ( surf_usm_h%alpha_vg_green(m) * h_vg    &
5759                                    )**surf_usm_h%n_vg_green(m) )**( ( 1.0_wp  - 1.0_wp     &
5760                                    / surf_usm_h%n_vg_green(m) ) *( surf_usm_h%l_vg_green(m) + 2.0_wp) ) )
5761
5762!
5763!--              Parametrization of Clapp & Hornberger
5764                 ELSE
5765                    gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m) * ( swc_h(kw,m)       &
5766                                    / swc_sat_h(kw,m) )**(2.0_wp * b_ch + 3.0_wp)
5767                 ENDIF
5768
5769              ENDDO
5770
5771!
5772!--           Prognostic equation for soil moisture content. Only performed,
5773!--           when humidity is enabled in the atmosphere
5774              IF ( humidity )  THEN
5775!
5776!--              Calculate soil diffusivity (lambda_w) at the _stag level
5777!--              using linear interpolation. To do: replace this with
5778!--              ECMWF-IFS Eq. 8.81
5779                 DO  kw = nzb_wall, nzt_wall-1
5780                   
5781                    surf_usm_h%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )  &
5782                                      * 0.5_wp
5783                    surf_usm_h%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1) + gamma_green_temp(kw) )    &
5784                                      * 0.5_wp
5785
5786                 ENDDO
5787
5788!
5789!--              In case of a closed bottom (= water content is conserved),
5790!--              set hydraulic conductivity to zero to that no water will be
5791!--              lost in the bottom layer.
5792                 IF ( conserve_water_content )  THEN
5793                    surf_usm_h%gamma_w_green(kw,m) = 0.0_wp
5794                 ELSE
5795                    surf_usm_h%gamma_w_green(kw,m) = gamma_green_temp(nzt_wall)
5796                 ENDIF     
5797
5798!--              The root extraction (= root_extr * qsws_veg / (rho_l     
5799!--              * l_v)) ensures the mass conservation for water. The         
5800!--              transpiration of plants equals the cumulative withdrawals by
5801!--              the roots in the soil. The scheme takes into account the
5802!--              availability of water in the soil layers as well as the root
5803!--              fraction in the respective layer. Layer with moisture below
5804!--              wilting point will not contribute, which reflects the
5805!--              preference of plants to take water from moister layers.
5806
5807!
5808!--              Calculate the root extraction (ECMWF 7.69, the sum of
5809!--              root_extr = 1). The energy balance solver guarantees a
5810!--              positive transpiration, so that there is no need for an
5811!--              additional check.
5812                 m_total = 0.0_wp
5813                 DO  kw = nzb_wall, nzt_wall
5814                     IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5815                        m_total = m_total + rootfr_h(kw,m) * swc_h(kw,m)
5816                     ENDIF
5817                 ENDDO 
5818
5819                 IF ( m_total > 0.0_wp )  THEN
5820                    DO  kw = nzb_wall, nzt_wall
5821                       IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5822                          root_extr_green(kw) = rootfr_h(kw,m) * swc_h(kw,m)      &
5823                                                          / m_total
5824                       ELSE
5825                          root_extr_green(kw) = 0.0_wp
5826                       ENDIF
5827                    ENDDO
5828                 ENDIF
5829
5830!
5831!--              Prognostic equation for soil water content m_soil.
5832                 tend(:) = 0.0_wp
5833
5834                 tend(nzb_wall) = ( surf_usm_h%lambda_w_green(nzb_wall,m) * (            &
5835                          swc_h(nzb_wall+1,m) - swc_h(nzb_wall,m) )    &
5836                          * surf_usm_h%ddz_green(nzb_wall+1,m) - surf_usm_h%gamma_w_green(nzb_wall,m) - ( &
5837                             root_extr_green(nzb_wall) * surf_usm_h%qsws_veg(m)          &
5838!                                + surf_usm_h%qsws_soil_green(m)
5839                                ) * drho_l_lv )             &
5840                               * surf_usm_h%ddz_green_stag(nzb_wall,m)
5841
5842                 DO  kw = nzb_wall+1, nzt_wall-1
5843                    tend(kw) = ( surf_usm_h%lambda_w_green(kw,m) * ( swc_h(kw+1,m)        &
5844                              - swc_h(kw,m) ) * surf_usm_h%ddz_green(kw+1,m)              &
5845                              - surf_usm_h%gamma_w_green(kw,m)                            &
5846                              - surf_usm_h%lambda_w_green(kw-1,m) * (swc_h(kw,m) -        &
5847                              swc_h(kw-1,m)) * surf_usm_h%ddz_green(kw,m)                 &
5848                              + surf_usm_h%gamma_w_green(kw-1,m) - (root_extr_green(kw)   &
5849                              * surf_usm_h%qsws_veg(m) * drho_l_lv)                       &
5850                              ) * surf_usm_h%ddz_green_stag(kw,m)
5851
5852                 ENDDO
5853                 tend(nzt_wall) = ( - surf_usm_h%gamma_w_green(nzt_wall,m)                  &
5854                                         - surf_usm_h%lambda_w_green(nzt_wall-1,m)          &
5855                                         * (swc_h(nzt_wall,m)             &
5856                                         - swc_h(nzt_wall-1,m))           &
5857                                         * surf_usm_h%ddz_green(nzt_wall,m)                 &
5858                                         + surf_usm_h%gamma_w_green(nzt_wall-1,m) - (       &
5859                                           root_extr_green(nzt_wall)               &
5860                                         * surf_usm_h%qsws_veg(m) * drho_l_lv  )   &
5861                                   ) * surf_usm_h%ddz_green_stag(nzt_wall,m)             
5862
5863                 swc_h_p(nzb_wall:nzt_wall,m) = swc_h(nzb_wall:nzt_wall,m)&
5864                                                 + dt_3d * ( tsc(2) * tend(:)   &
5865                                                 + tsc(3) * surf_usm_h%tswc_h_m(:,m) )   
5866 
5867!
5868!--              Account for dry soils (find a better solution here!)
5869                 DO  kw = nzb_wall, nzt_wall
5870                    IF ( swc_h_p(kw,m) < 0.0_wp )  swc_h_p(kw,m) = 0.0_wp
5871                 ENDDO
5872
5873!
5874!--              Calculate m_soil tendencies for the next Runge-Kutta step
5875                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
5876                    IF ( intermediate_timestep_count == 1 )  THEN
5877                       DO  kw = nzb_wall, nzt_wall
5878                          surf_usm_h%tswc_h_m(kw,m) = tend(kw)
5879                       ENDDO
5880                    ELSEIF ( intermediate_timestep_count <                   &
5881                             intermediate_timestep_count_max )  THEN
5882                       DO  kw = nzb_wall, nzt_wall
5883                          surf_usm_h%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp&
5884                                   * surf_usm_h%tswc_h_m(kw,m)
5885                       ENDDO
5886                    ENDIF
5887                 ENDIF
5888              ENDIF
5889
5890           ENDIF
5891           
5892        ENDDO
5893        !$OMP END PARALLEL
5894
5895!
5896!--     For vertical surfaces     
5897        DO  l = 0, 3                             
5898           DO  m = 1, surf_usm_v(l)%ns
5899
5900              IF (surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp) THEN
5901!
5902!-- no substrate layer for green walls / only groundbase green walls (ivy i.e.) -> green layers get same
5903!-- temperature as first wall layer
5904!-- there fore no temperature calculations for vertical green substrate layers now
5905
5906!
5907! !
5908! !--              Obtain indices
5909!                  i = surf_usm_v(l)%i(m)           
5910!                  j = surf_usm_v(l)%j(m)
5911!                  k = surf_usm_v(l)%k(m)
5912!   
5913!                  t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
5914! !
5915! !--              prognostic equation for green temperature t_green_v
5916!                  gtend(:) = 0.0_wp
5917!                  gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
5918!                                          ( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
5919!                                            ( t_green_v(l)%t(nzb_wall+1,m)             &
5920!                                            - t_green_v(l)%t(nzb_wall,m) ) *           &
5921!                                            surf_usm_v(l)%ddz_green(nzb_wall+1,m)      &
5922!                                          + surf_usm_v(l)%wghf_eb(m) ) *               &
5923!                                            surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
5924!               
5925!                  DO  kw = nzb_wall+1, nzt_wall
5926!                     gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m))          &
5927!                               * (   surf_usm_v(l)%lambda_h_green(kw,m)              &
5928!                                 * ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
5929!                                 * surf_usm_v(l)%ddz_green(kw+1,m)                   &
5930!                               - surf_usm_v(l)%lambda_h(kw-1,m)                      &
5931!                                 * ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
5932!                                 * surf_usm_v(l)%ddz_green(kw,m) )                   &
5933!                               * surf_usm_v(l)%ddz_green_stag(kw,m)
5934!                  ENDDO
5935!   
5936!                  t_green_v_p(l)%t(nzb_wall:nzt_wall,m) =                              &
5937!                                       t_green_v(l)%t(nzb_wall:nzt_wall,m)             &
5938!                                     + dt_3d * ( tsc(2)                                &
5939!                                     * gtend(nzb_wall:nzt_wall) + tsc(3)               &
5940!                                     * surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall,m) )   
5941!   
5942! !
5943! !--              calculate t_green tendencies for the next Runge-Kutta step
5944!                  IF ( timestep_scheme(1:5) == 'runge' )  THEN
5945!                      IF ( intermediate_timestep_count == 1 )  THEN
5946!                         DO  kw = nzb_wall, nzt_wall
5947!                            surf_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
5948!                         ENDDO
5949!                      ELSEIF ( intermediate_timestep_count <                           &
5950!                               intermediate_timestep_count_max )  THEN
5951!                          DO  kw = nzb_wall, nzt_wall
5952!                             surf_usm_v(l)%tt_green_m(kw,m) =                          &
5953!                                         - 9.5625_wp * gtend(kw) +                     &
5954!                                           5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
5955!                          ENDDO
5956!                      ENDIF
5957!                  ENDIF
5958
5959                 DO  kw = nzb_wall, nzt_wall+1
5960                     t_green_v(l)%t(kw,m) = t_wall_v(l)%t(nzb_wall,m)
5961                 ENDDO
5962             
5963              ENDIF
5964
5965           ENDDO
5966        ENDDO
5967
5968        IF ( debug_output )  CALL debug_message( 'usm_green_heat_model', 'end' )
5969
5970    END SUBROUTINE usm_green_heat_model
5971
5972!------------------------------------------------------------------------------!
5973! Description:
5974! ------------
5975!> Parin for &usm_par for urban surface model
5976!------------------------------------------------------------------------------!
5977    SUBROUTINE usm_parin
5978
5979       IMPLICIT NONE
5980
5981       CHARACTER (LEN=80) ::  line  !< string containing current line of file PARIN
5982
5983       NAMELIST /urban_surface_par/                                            &
5984                           building_type,                                      &
5985                           land_category,                                      &
5986                           naheatlayers,                                       &
5987                           pedestrian_category,                                &
5988                           roughness_concrete,                                 &
5989                           read_wall_temp_3d,                                  &
5990                           roof_category,                                      &
5991                           urban_surface,                                      &
5992                           usm_anthropogenic_heat,                             &
5993                           usm_material_model,                                 &
5994                           wall_category,                                      &
5995                           wall_inner_temperature,                             &
5996                           roof_inner_temperature,                             &
5997                           soil_inner_temperature,                             &
5998                           window_inner_temperature,                           &
5999                           usm_wall_mod
6000
6001       NAMELIST /urban_surface_parameters/                                     &
6002                           building_type,                                      &
6003                           land_category,                                      &
6004                           naheatlayers,                                       &
6005                           pedestrian_category,                                &
6006                           roughness_concrete,                                 &
6007                           read_wall_temp_3d,                                  &
6008                           roof_category,                                      &
6009                           urban_surface,                                      &
6010                           usm_anthropogenic_heat,                             &
6011                           usm_material_model,                                 &
6012                           wall_category,                                      &
6013                           wall_inner_temperature,                             &
6014                           roof_inner_temperature,                             &
6015                           soil_inner_temperature,                             &
6016                           window_inner_temperature,                           &
6017                           usm_wall_mod
6018                           
6019 
6020!
6021!--    Try to find urban surface model package
6022       REWIND ( 11 )
6023       line = ' '
6024       DO WHILE ( INDEX( line, '&urban_surface_parameters' ) == 0 )
6025          READ ( 11, '(A)', END=12 )  line
6026       ENDDO
6027       BACKSPACE ( 11 )
6028
6029!
6030!--    Read user-defined namelist
6031       READ ( 11, urban_surface_parameters, ERR = 10 )
6032
6033!
6034!--    Set flag that indicates that the urban surface model is switched on
6035       urban_surface = .TRUE.
6036
6037       GOTO 14
6038
6039 10    BACKSPACE( 11 )
6040       READ( 11 , '(A)') line
6041       CALL parin_fail_message( 'urban_surface_parameters', line )
6042!
6043!--    Try to find old namelist
6044 12    REWIND ( 11 )
6045       line = ' '
6046       DO WHILE ( INDEX( line, '&urban_surface_par' ) == 0 )
6047          READ ( 11, '(A)', END=14 )  line
6048       ENDDO
6049       BACKSPACE ( 11 )
6050
6051!
6052!--    Read user-defined namelist
6053       READ ( 11, urban_surface_par, ERR = 13, END = 14 )
6054
6055       message_string = 'namelist urban_surface_par is deprecated and will be ' // &
6056                     'removed in near future. Please use namelist ' //   &
6057                     'urban_surface_parameters instead'
6058       CALL message( 'usm_parin', 'PA0487', 0, 1, 0, 6, 0 )
6059
6060!
6061!--    Set flag that indicates that the urban surface model is switched on
6062       urban_surface = .TRUE.
6063
6064       GOTO 14
6065
6066 13    BACKSPACE( 11 )
6067       READ( 11 , '(A)') line
6068       CALL parin_fail_message( 'urban_surface_par', line )
6069
6070
6071 14    CONTINUE
6072
6073
6074    END SUBROUTINE usm_parin
6075
6076 
6077!------------------------------------------------------------------------------!
6078! Description:
6079! ------------
6080!
6081!> This subroutine is part of the urban surface model.
6082!> It reads daily heat produced by anthropogenic sources
6083!> and the diurnal cycle of the heat.
6084!------------------------------------------------------------------------------!
6085    SUBROUTINE usm_read_anthropogenic_heat
6086   
6087        INTEGER(iwp)                  :: i,j,k,ii  !< running indices
6088        REAL(wp)                      :: heat      !< anthropogenic heat
6089
6090!
6091!--     allocation of array of sources of anthropogenic heat and their diural profile
6092        ALLOCATE( aheat(naheatlayers,nys:nyn,nxl:nxr) )
6093        ALLOCATE( aheatprof(naheatlayers,0:24) )
6094
6095!
6096!--     read daily amount of heat and its daily cycle
6097        aheat = 0.0_wp
6098        DO  ii = 0, io_blocks-1
6099            IF ( ii == io_group )  THEN
6100
6101!--             open anthropogenic heat file
6102                OPEN( 151, file='ANTHROPOGENIC_HEAT'//TRIM(coupling_char), action='read', &
6103                           status='old', form='formatted', err=11 )
6104                i = 0
6105                j = 0
6106                DO
6107                    READ( 151, *, err=12, end=13 )  i, j, k, heat
6108                    IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )  THEN
6109                        IF ( k <= naheatlayers  .AND.  k > get_topography_top_index_ji( j, i, 's' ) )  THEN
6110!--                         write heat into the array
6111                            aheat(k,j,i) = heat
6112                        ENDIF
6113                    ENDIF
6114                    CYCLE
6115 12                 WRITE(message_string,'(a,2i4)') 'error in file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' after line ',i,j
6116                    CALL message( 'usm_read_anthropogenic_heat', 'PA0515', 0, 1, 0, 6, 0 )
6117                ENDDO
6118 13             CLOSE(151)
6119                CYCLE
6120 11             message_string = 'file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' does not exist'
6121                CALL message( 'usm_read_anthropogenic_heat', 'PA0516', 1, 2, 0, 6, 0 )
6122            ENDIF
6123           
6124#if defined( __parallel )
6125            CALL MPI_BARRIER( comm2d, ierr )
6126#endif
6127        ENDDO
6128       
6129!
6130!--     read diurnal profiles of heat sources
6131        aheatprof = 0.0_wp
6132        DO  ii = 0, io_blocks-1
6133            IF ( ii == io_group )  THEN
6134!
6135!--             open anthropogenic heat profile file
6136                OPEN( 151, file='ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char), action='read', &
6137                           status='old', form='formatted', err=21 )
6138                i = 0
6139                DO
6140                    READ( 151, *, err=22, end=23 )  i, k, heat
6141                    IF ( i >= 0  .AND.  i <= 24  .AND.  k <= naheatlayers )  THEN
6142!--                     write heat into the array
6143                        aheatprof(k,i) = heat
6144                    ENDIF
6145                    CYCLE
6146 22                 WRITE(message_string,'(a,i4)') 'error in file ANTHROPOGENIC_HEAT_PROFILE'// &
6147                                                     TRIM(coupling_char)//' after line ',i
6148                    CALL message( 'usm_read_anthropogenic_heat', 'PA0517', 0, 1, 0, 6, 0 )
6149                ENDDO
6150                aheatprof(:,24) = aheatprof(:,0)
6151 23             CLOSE(151)
6152                CYCLE
6153 21             message_string = 'file ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char)//' does not exist'
6154                CALL message( 'usm_read_anthropogenic_heat', 'PA0518', 1, 2, 0, 6, 0 )
6155            ENDIF
6156           
6157#if defined( __parallel )
6158            CALL MPI_BARRIER( comm2d, ierr )
6159#endif
6160        ENDDO
6161       
6162    END SUBROUTINE usm_read_anthropogenic_heat
6163   
6164
6165!------------------------------------------------------------------------------!
6166! Description:
6167! ------------
6168!> Soubroutine reads t_surf and t_wall data from restart files
6169!------------------------------------------------------------------------------!
6170    SUBROUTINE usm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, nyn_on_file,    &
6171                              nysf, nysc, nys_on_file, found )
6172
6173
6174       USE control_parameters,                                                 &
6175           ONLY: length, restart_string
6176           
6177       IMPLICIT NONE
6178
6179       INTEGER(iwp)       ::  k                 !< running index over previous input files covering current local domain
6180       INTEGER(iwp)       ::  l                 !< index variable for surface type
6181       INTEGER(iwp)       ::  ns_h_on_file_usm  !< number of horizontal surface elements (urban type) on file
6182       INTEGER(iwp)       ::  nxlc              !< index of left boundary on current subdomain
6183       INTEGER(iwp)       ::  nxlf              !< index of left boundary on former subdomain
6184       INTEGER(iwp)       ::  nxl_on_file       !< index of left boundary on former local domain
6185       INTEGER(iwp)       ::  nxrf              !< index of right boundary on former subdomain
6186       INTEGER(iwp)       ::  nxr_on_file       !< index of right boundary on former local domain
6187       INTEGER(iwp)       ::  nynf              !< index of north boundary on former subdomain
6188       INTEGER(iwp)       ::  nyn_on_file       !< index of north boundary on former local domain
6189       INTEGER(iwp)       ::  nysc              !< index of south boundary on current subdomain
6190       INTEGER(iwp)       ::  nysf              !< index of south boundary on former subdomain
6191       INTEGER(iwp)       ::  nys_on_file       !< index of south boundary on former local domain
6192       
6193       INTEGER(iwp)       ::  ns_v_on_file_usm(0:3)  !< number of vertical surface elements (urban type) on file
6194       
6195       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  start_index_on_file 
6196       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  end_index_on_file
6197
6198       LOGICAL, INTENT(OUT)  ::  found 
6199!!!    suehring: Why the SAVE attribute?       
6200       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_wall_h
6201       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_window_h
6202       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_green_h
6203       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_waste_h
6204       
6205       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_wall_h
6206       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_window_h
6207       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_green_h
6208       
6209       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v
6210       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_window_v
6211       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_green_v
6212       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_waste_v
6213       
6214       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_wall_v
6215       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_window_v
6216       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_green_v
6217
6218
6219       found = .TRUE.
6220
6221
6222          SELECT CASE ( restart_string(1:length) ) 
6223
6224             CASE ( 'ns_h_on_file_usm') 
6225                IF ( k == 1 )  THEN
6226                   READ ( 13 ) ns_h_on_file_usm
6227               
6228                   IF ( ALLOCATED( tmp_surf_wall_h ) ) DEALLOCATE( tmp_surf_wall_h )
6229                   IF ( ALLOCATED( tmp_wall_h ) ) DEALLOCATE( tmp_wall_h ) 
6230                   IF ( ALLOCATED( tmp_surf_window_h ) )                       &
6231                      DEALLOCATE( tmp_surf_window_h ) 
6232                   IF ( ALLOCATED( tmp_window_h) ) DEALLOCATE( tmp_window_h ) 
6233                   IF ( ALLOCATED( tmp_surf_green_h) )                         &
6234                      DEALLOCATE( tmp_surf_green_h ) 
6235                   IF ( ALLOCATED( tmp_green_h) ) DEALLOCATE( tmp_green_h )
6236                   IF ( ALLOCATED( tmp_surf_waste_h) )                         &
6237                      DEALLOCATE( tmp_surf_waste_h )
6238 
6239!
6240!--                Allocate temporary arrays for reading data on file. Note,
6241!--                the size of allocated surface elements do not necessarily
6242!--                need  to match the size of present surface elements on
6243!--                current processor, as the number of processors between
6244!--                restarts can change.
6245                   ALLOCATE( tmp_surf_wall_h(1:ns_h_on_file_usm) )
6246                   ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1,                   &
6247                                        1:ns_h_on_file_usm) )
6248                   ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
6249                   ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1,                 &
6250                                          1:ns_h_on_file_usm) )
6251                   ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
6252                   ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1,                  &
6253                                         1:ns_h_on_file_usm) )
6254                   ALLOCATE( tmp_surf_waste_h(1:ns_h_on_file_usm) )
6255
6256                ENDIF
6257
6258             CASE ( 'ns_v_on_file_usm')
6259                IF ( k == 1 )  THEN
6260                   READ ( 13 ) ns_v_on_file_usm 
6261
6262                   DO  l = 0, 3
6263                      IF ( ALLOCATED( tmp_surf_wall_v(l)%t ) )                 &
6264                         DEALLOCATE( tmp_surf_wall_v(l)%t )
6265                      IF ( ALLOCATED( tmp_wall_v(l)%t ) )                      &
6266                         DEALLOCATE( tmp_wall_v(l)%t )
6267                      IF ( ALLOCATED( tmp_surf_window_v(l)%t ) )               & 
6268                         DEALLOCATE( tmp_surf_window_v(l)%t )
6269                      IF ( ALLOCATED( tmp_window_v(l)%t ) )                    &
6270                         DEALLOCATE( tmp_window_v(l)%t )
6271                      IF ( ALLOCATED( tmp_surf_green_v(l)%t ) )                &
6272                         DEALLOCATE( tmp_surf_green_v(l)%t )
6273                      IF ( ALLOCATED( tmp_green_v(l)%t ) )                     &
6274                         DEALLOCATE( tmp_green_v(l)%t )
6275                      IF ( ALLOCATED( tmp_surf_waste_v(l)%t ) )                &
6276                         DEALLOCATE( tmp_surf_waste_v(l)%t )
6277                   ENDDO 
6278
6279!
6280!--                Allocate temporary arrays for reading data on file. Note,
6281!--                the size of allocated surface elements do not necessarily
6282!--                need to match the size of present surface elements on
6283!--                current processor, as the number of processors between
6284!--                restarts can change.
6285                   DO  l = 0, 3
6286                      ALLOCATE( tmp_surf_wall_v(l)%t(1:ns_v_on_file_usm(l)) )
6287                      ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1,           &
6288                                                1:ns_v_on_file_usm(l) ) )
6289                      ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
6290                      ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1,         & 
6291                                                  1:ns_v_on_file_usm(l) ) )
6292                      ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
6293                      ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1,          &
6294                                                 1:ns_v_on_file_usm(l) ) )
6295                      ALLOCATE( tmp_surf_waste_v(l)%t(1:ns_v_on_file_usm(l)) )
6296                   ENDDO
6297
6298                ENDIF   
6299         
6300             CASE ( 'usm_start_index_h', 'usm_start_index_v'  )   
6301                IF ( k == 1 )  THEN
6302
6303                   IF ( ALLOCATED( start_index_on_file ) )                     &
6304                      DEALLOCATE( start_index_on_file )
6305
6306                   ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file,     &
6307                                                  nxl_on_file:nxr_on_file) )
6308
6309                   READ ( 13 )  start_index_on_file
6310
6311                ENDIF
6312               
6313             CASE ( 'usm_end_index_h', 'usm_end_index_v' )   
6314                IF ( k == 1 )  THEN
6315
6316                   IF ( ALLOCATED( end_index_on_file ) )                       &
6317                      DEALLOCATE( end_index_on_file )
6318
6319                   ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file,       &
6320                                                nxl_on_file:nxr_on_file) )
6321
6322                   READ ( 13 )  end_index_on_file
6323
6324                ENDIF
6325         
6326             CASE ( 't_surf_wall_h' )
6327                IF ( k == 1 )  THEN
6328                   IF ( .NOT.  ALLOCATED( t_surf_wall_h_1 ) )                  &
6329                      ALLOCATE( t_surf_wall_h_1(1:surf_usm_h%ns) )
6330                   READ ( 13 )  tmp_surf_wall_h
6331                ENDIF             
6332                CALL surface_restore_elements(                                 &
6333                                        t_surf_wall_h_1, tmp_surf_wall_h,      &
6334                                        surf_usm_h%start_index,                &
6335                                        start_index_on_file,                   &
6336                                        end_index_on_file,                     &
6337                                        nxlc, nysc,                            &
6338                                        nxlf, nxrf, nysf, nynf,                &
6339                                        nys_on_file, nyn_on_file,              &
6340                                        nxl_on_file,nxr_on_file )
6341
6342             CASE ( 't_surf_wall_v(0)' )
6343                IF ( k == 1 )  THEN
6344                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(0)%t ) )             &
6345                      ALLOCATE( t_surf_wall_v_1(0)%t(1:surf_usm_v(0)%ns) )
6346                   READ ( 13 )  tmp_surf_wall_v(0)%t
6347                ENDIF
6348                CALL surface_restore_elements(                                 &
6349                                        t_surf_wall_v_1(0)%t, tmp_surf_wall_v(0)%t,      &
6350                                        surf_usm_v(0)%start_index,             & 
6351                                        start_index_on_file,                   &
6352                                        end_index_on_file,                     &
6353                                        nxlc, nysc,                            &
6354                                        nxlf, nxrf, nysf, nynf,                &
6355                                        nys_on_file, nyn_on_file,              &
6356                                        nxl_on_file,nxr_on_file )
6357                     
6358             CASE ( 't_surf_wall_v(1)' )
6359                IF ( k == 1 )  THEN
6360                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(1)%t ) )             &
6361                      ALLOCATE( t_surf_wall_v_1(1)%t(1:surf_usm_v(1)%ns) )
6362                   READ ( 13 )  tmp_surf_wall_v(1)%t
6363                ENDIF
6364                CALL surface_restore_elements(                                 &
6365                                        t_surf_wall_v_1(1)%t, tmp_surf_wall_v(1)%t,      &
6366                                        surf_usm_v(1)%start_index,             & 
6367                                        start_index_on_file,                   &
6368                                        end_index_on_file,                     &
6369                                        nxlc, nysc,                            &
6370                                        nxlf, nxrf, nysf, nynf,                &
6371                                        nys_on_file, nyn_on_file,              &
6372                                        nxl_on_file,nxr_on_file )
6373
6374             CASE ( 't_surf_wall_v(2)' )
6375                IF ( k == 1 )  THEN
6376                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(2)%t ) )             &
6377                      ALLOCATE( t_surf_wall_v_1(2)%t(1:surf_usm_v(2)%ns) )
6378                   READ ( 13 )  tmp_surf_wall_v(2)%t
6379                ENDIF
6380                CALL surface_restore_elements(                                 &
6381                                        t_surf_wall_v_1(2)%t, tmp_surf_wall_v(2)%t,      &
6382                                        surf_usm_v(2)%start_index,             & 
6383                                        start_index_on_file,                   &
6384                                        end_index_on_file,                     &
6385                                        nxlc, nysc,                            &
6386                                        nxlf, nxrf, nysf, nynf,                &
6387                                        nys_on_file, nyn_on_file,              &
6388                                        nxl_on_file,nxr_on_file )
6389                     
6390             CASE ( 't_surf_wall_v(3)' )
6391                IF ( k == 1 )  THEN
6392                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(3)%t ) )             &
6393                      ALLOCATE( t_surf_wall_v_1(3)%t(1:surf_usm_v(3)%ns) )
6394                   READ ( 13 )  tmp_surf_wall_v(3)%t
6395                ENDIF
6396                CALL surface_restore_elements(                                 &
6397                                        t_surf_wall_v_1(3)%t, tmp_surf_wall_v(3)%t,      &
6398                                        surf_usm_v(3)%start_index,             & 
6399                                        start_index_on_file,                   &
6400                                        end_index_on_file,                     &
6401                                        nxlc, nysc,                            &
6402                                        nxlf, nxrf, nysf, nynf,                &
6403                                        nys_on_file, nyn_on_file,              &
6404                                        nxl_on_file,nxr_on_file )
6405
6406             CASE ( 't_surf_green_h' )
6407                IF ( k == 1 )  THEN
6408                   IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )                 &
6409                      ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
6410                   READ ( 13 )  tmp_surf_green_h
6411                ENDIF
6412                CALL surface_restore_elements(                                 &
6413                                        t_surf_green_h_1, tmp_surf_green_h,    &
6414                                        surf_usm_h%start_index,                & 
6415                                        start_index_on_file,                   &
6416                                        end_index_on_file,                     &
6417                                        nxlc, nysc,                            &
6418                                        nxlf, nxrf, nysf, nynf,                &
6419                                        nys_on_file, nyn_on_file,              &
6420                                        nxl_on_file,nxr_on_file )
6421
6422             CASE ( 't_surf_green_v(0)' )
6423                IF ( k == 1 )  THEN
6424                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%t ) )            &
6425                      ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
6426                   READ ( 13 )  tmp_surf_green_v(0)%t
6427                ENDIF
6428                CALL surface_restore_elements(                                 &
6429                                        t_surf_green_v_1(0)%t,                 &
6430                                        tmp_surf_green_v(0)%t,                 &
6431                                        surf_usm_v(0)%start_index,             & 
6432                                        start_index_on_file,                   &
6433                                        end_index_on_file,                     &
6434                                        nxlc, nysc,                            &
6435                                        nxlf, nxrf, nysf, nynf,                &
6436                                        nys_on_file, nyn_on_file,              &
6437                                        nxl_on_file,nxr_on_file )
6438                   
6439             CASE ( 't_surf_green_v(1)' )
6440                IF ( k == 1 )  THEN
6441                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%t ) )            &
6442                      ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
6443                   READ ( 13 )  tmp_surf_green_v(1)%t
6444                ENDIF
6445                CALL surface_restore_elements(                                 &
6446                                        t_surf_green_v_1(1)%t,                 &
6447                                        tmp_surf_green_v(1)%t,                 &
6448                                        surf_usm_v(1)%start_index,             & 
6449                                        start_index_on_file,                   &
6450                                        end_index_on_file,                     &
6451                                        nxlc, nysc,                            &
6452                                        nxlf, nxrf, nysf, nynf,                &
6453                                        nys_on_file, nyn_on_file,              &
6454                                        nxl_on_file,nxr_on_file )
6455
6456             CASE ( 't_surf_green_v(2)' )
6457                IF ( k == 1 )  THEN
6458                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%t ) )            &
6459                      ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
6460                   READ ( 13 )  tmp_surf_green_v(2)%t
6461                ENDIF
6462                CALL surface_restore_elements(                                 &
6463                                        t_surf_green_v_1(2)%t,                 &
6464                                        tmp_surf_green_v(2)%t,                 &
6465                                        surf_usm_v(2)%start_index,             & 
6466                                        start_index_on_file,                   &
6467                                        end_index_on_file,                     &
6468                                        nxlc, nysc,                            &
6469                                        nxlf, nxrf, nysf, nynf,                &
6470                                        nys_on_file, nyn_on_file,              &
6471                                        nxl_on_file,nxr_on_file )
6472                   
6473             CASE ( 't_surf_green_v(3)' )
6474                IF ( k == 1 )  THEN
6475                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%t ) )            &
6476                      ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
6477                   READ ( 13 )  tmp_surf_green_v(3)%t
6478                ENDIF
6479                CALL surface_restore_elements(                                 &
6480                                        t_surf_green_v_1(3)%t,                 & 
6481                                        tmp_surf_green_v(3)%t,                 &
6482                                        surf_usm_v(3)%start_index,             & 
6483                                        start_index_on_file,                   &
6484                                        end_index_on_file,                     &
6485                                        nxlc, nysc,                            &
6486                                        nxlf, nxrf, nysf, nynf,                &
6487                                        nys_on_file, nyn_on_file,              &
6488                                        nxl_on_file,nxr_on_file )
6489
6490             CASE ( 't_surf_window_h' )
6491                IF ( k == 1 )  THEN
6492                   IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )                &
6493                      ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
6494                   READ ( 13 )  tmp_surf_window_h
6495                ENDIF
6496                CALL surface_restore_elements(                                 &
6497                                        t_surf_window_h_1,                     &
6498                                        tmp_surf_window_h,                     &
6499                                        surf_usm_h%start_index,                & 
6500                                        start_index_on_file,                   &
6501                                        end_index_on_file,                     &
6502                                        nxlc, nysc,                            &
6503                                        nxlf, nxrf, nysf, nynf,                &
6504                                        nys_on_file, nyn_on_file,              &
6505                                        nxl_on_file,nxr_on_file )
6506
6507             CASE ( 't_surf_window_v(0)' )
6508                IF ( k == 1 )  THEN
6509                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%t ) )           &
6510                      ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
6511                   READ ( 13 )  tmp_surf_window_v(0)%t
6512                ENDIF
6513                CALL surface_restore_elements(                                 &
6514                                        t_surf_window_v_1(0)%t,                &
6515                                        tmp_surf_window_v(0)%t,                &
6516                                        surf_usm_v(0)%start_index,             & 
6517                                        start_index_on_file,                   &
6518                                        end_index_on_file,                     &
6519                                        nxlc, nysc,                            &
6520                                        nxlf, nxrf, nysf, nynf,                &
6521                                        nys_on_file, nyn_on_file,              &
6522                                        nxl_on_file,nxr_on_file )
6523                   
6524             CASE ( 't_surf_window_v(1)' )
6525                IF ( k == 1 )  THEN
6526                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%t ) )           &
6527                      ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
6528                   READ ( 13 )  tmp_surf_window_v(1)%t
6529                ENDIF
6530                CALL surface_restore_elements(                                 &
6531                                        t_surf_window_v_1(1)%t,                &
6532                                        tmp_surf_window_v(1)%t,                &
6533                                        surf_usm_v(1)%start_index,             & 
6534                                        start_index_on_file,                   &
6535                                        end_index_on_file,                     &
6536                                        nxlc, nysc,                            &
6537                                        nxlf, nxrf, nysf, nynf,                &
6538                                        nys_on_file, nyn_on_file,              &
6539                                        nxl_on_file,nxr_on_file )
6540
6541             CASE ( 't_surf_window_v(2)' )
6542                IF ( k == 1 )  THEN
6543                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%t ) )           &
6544                      ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
6545                   READ ( 13 )  tmp_surf_window_v(2)%t
6546                ENDIF
6547                CALL surface_restore_elements(                                 &
6548                                        t_surf_window_v_1(2)%t,                & 
6549                                        tmp_surf_window_v(2)%t,                &
6550                                        surf_usm_v(2)%start_index,             & 
6551                                        start_index_on_file,                   &
6552                                        end_index_on_file,                     &
6553                                        nxlc, nysc,                            &
6554                                        nxlf, nxrf, nysf, nynf,                &
6555                                        nys_on_file, nyn_on_file,              &
6556                                        nxl_on_file,nxr_on_file )
6557                   
6558             CASE ( 't_surf_window_v(3)' )
6559                IF ( k == 1 )  THEN
6560                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%t ) )           &
6561                      ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
6562                   READ ( 13 )  tmp_surf_window_v(3)%t
6563                ENDIF
6564                CALL surface_restore_elements(                                 &
6565                                        t_surf_window_v_1(3)%t,                & 
6566                                        tmp_surf_window_v(3)%t,                &
6567                                        surf_usm_v(3)%start_index,             & 
6568                                        start_index_on_file,                   &
6569                                        end_index_on_file,                     &
6570                                        nxlc, nysc,                            &
6571                                        nxlf, nxrf, nysf, nynf,                &
6572                                        nys_on_file, nyn_on_file,              &
6573                                        nxl_on_file,nxr_on_file )
6574
6575             CASE ( 'waste_heat_h' )
6576                IF ( k == 1 )  THEN
6577                   IF ( .NOT.  ALLOCATED( surf_usm_h%waste_heat ) )            &
6578                      ALLOCATE( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
6579                   READ ( 13 )  tmp_surf_waste_h
6580                ENDIF             
6581                CALL surface_restore_elements(                                 &
6582                                        surf_usm_h%waste_heat,                 &
6583                                        tmp_surf_waste_h,                      &
6584                                        surf_usm_h%start_index,                &
6585                                        start_index_on_file,                   &
6586                                        end_index_on_file,                     &
6587                                        nxlc, nysc,                            &
6588                                        nxlf, nxrf, nysf, nynf,                &
6589                                        nys_on_file, nyn_on_file,              &
6590                                        nxl_on_file,nxr_on_file )                 
6591                                       
6592             CASE ( 'waste_heat_v(0)' )
6593                IF ( k == 1 )  THEN
6594                   IF ( .NOT.  ALLOCATED( surf_usm_v(0)%waste_heat ) )         &
6595                      ALLOCATE( surf_usm_v(0)%waste_heat(1:surf_usm_v(0)%ns) )
6596                   READ ( 13 )  tmp_surf_waste_v(0)%t
6597                ENDIF
6598                CALL surface_restore_elements(                                 &
6599                                        surf_usm_v(0)%waste_heat,              &
6600                                        tmp_surf_waste_v(0)%t,                 &
6601                                        surf_usm_v(0)%start_index,             & 
6602                                        start_index_on_file,                   &
6603                                        end_index_on_file,                     &
6604                                        nxlc, nysc,                            &
6605                                        nxlf, nxrf, nysf, nynf,                &
6606                                        nys_on_file, nyn_on_file,              &
6607                                        nxl_on_file,nxr_on_file )
6608                     
6609             CASE ( 'waste_heat_v(1)' )
6610                IF ( k == 1 )  THEN
6611                   IF ( .NOT.  ALLOCATED( surf_usm_v(1)%waste_heat ) )         &
6612                      ALLOCATE( surf_usm_v(1)%waste_heat(1:surf_usm_v(1)%ns) )
6613                   READ ( 13 )  tmp_surf_waste_v(1)%t
6614                ENDIF
6615                CALL surface_restore_elements(                                 &
6616                                        surf_usm_v(1)%waste_heat,              &
6617                                        tmp_surf_waste_v(1)%t,                 &
6618                                        surf_usm_v(1)%start_index,             & 
6619                                        start_index_on_file,                   &
6620                                        end_index_on_file,                     &
6621                                        nxlc, nysc,                            &
6622                                        nxlf, nxrf, nysf, nynf,                &
6623                                        nys_on_file, nyn_on_file,              &
6624                                        nxl_on_file,nxr_on_file )
6625
6626             CASE ( 'waste_heat_v(2)' )
6627                IF ( k == 1 )  THEN
6628                   IF ( .NOT.  ALLOCATED( surf_usm_v(2)%waste_heat ) )         &
6629                      ALLOCATE( surf_usm_v(2)%waste_heat(1:surf_usm_v(2)%ns) )
6630                   READ ( 13 )  tmp_surf_waste_v(2)%t
6631                ENDIF
6632                CALL surface_restore_elements(                                 &
6633                                        surf_usm_v(2)%waste_heat,              &
6634                                        tmp_surf_waste_v(2)%t,                 &
6635                                        surf_usm_v(2)%start_index,             & 
6636                                        start_index_on_file,                   &
6637                                        end_index_on_file,                     &
6638                                        nxlc, nysc,                            &
6639                                        nxlf, nxrf, nysf, nynf,                &
6640                                        nys_on_file, nyn_on_file,              &
6641                                        nxl_on_file,nxr_on_file )
6642                     
6643             CASE ( 'waste_heat_v(3)' )
6644                IF ( k == 1 )  THEN
6645                   IF ( .NOT.  ALLOCATED( surf_usm_v(3)%waste_heat ) )         &
6646                      ALLOCATE( surf_usm_v(3)%waste_heat(1:surf_usm_v(3)%ns) )
6647                   READ ( 13 )  tmp_surf_waste_v(3)%t
6648                ENDIF
6649                CALL surface_restore_elements(                                 &
6650                                        surf_usm_v(3)%waste_heat,              &
6651                                        tmp_surf_waste_v(3)%t,                 &
6652                                        surf_usm_v(3)%start_index,             & 
6653                                        start_index_on_file,                   &
6654                                        end_index_on_file,                     &
6655                                        nxlc, nysc,                            &
6656                                        nxlf, nxrf, nysf, nynf,                &
6657                                        nys_on_file, nyn_on_file,              &
6658                                        nxl_on_file,nxr_on_file )
6659
6660             CASE ( 't_wall_h' )
6661                IF ( k == 1 )  THEN
6662                   IF ( .NOT.  ALLOCATED( t_wall_h_1 ) )                       &
6663                      ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1,                &
6664                                           1:surf_usm_h%ns) )
6665                   READ ( 13 )  tmp_wall_h
6666                ENDIF
6667                CALL surface_restore_elements(                                 &
6668                                        t_wall_h_1, tmp_wall_h,                &
6669                                        surf_usm_h%start_index,                & 
6670                                        start_index_on_file,                   &
6671                                        end_index_on_file,                     &
6672                                        nxlc, nysc,                            &
6673                                        nxlf, nxrf, nysf, nynf,                &
6674                                        nys_on_file, nyn_on_file,              &
6675                                        nxl_on_file,nxr_on_file )
6676
6677             CASE ( 't_wall_v(0)' )
6678                IF ( k == 1 )  THEN
6679                   IF ( .NOT.  ALLOCATED( t_wall_v_1(0)%t ) )                  &
6680                      ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1,           &
6681                                                1:surf_usm_v(0)%ns) )
6682                   READ ( 13 )  tmp_wall_v(0)%t
6683                ENDIF
6684                CALL surface_restore_elements(                                 &
6685                                        t_wall_v_1(0)%t, tmp_wall_v(0)%t,      &
6686                                        surf_usm_v(0)%start_index,             & 
6687                                        start_index_on_file,                   &
6688                                        end_index_on_file,                     &
6689                                        nxlc, nysc,                            &
6690                                        nxlf, nxrf, nysf, nynf,                &
6691                                        nys_on_file, nyn_on_file,              &
6692                                        nxl_on_file,nxr_on_file )
6693
6694             CASE ( 't_wall_v(1)' )
6695                IF ( k == 1 )  THEN
6696                   IF ( .NOT.  ALLOCATED( t_wall_v_1(1)%t ) )                  &
6697                      ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1,           &
6698                                                1:surf_usm_v(1)%ns) )
6699                   READ ( 13 )  tmp_wall_v(1)%t
6700                ENDIF
6701                CALL surface_restore_elements(                                 &
6702                                        t_wall_v_1(1)%t, tmp_wall_v(1)%t,      &
6703                                        surf_usm_v(1)%start_index,             & 
6704                                        start_index_on_file,                   &
6705                                        end_index_on_file,                     &
6706                                        nxlc, nysc,                            &
6707                                        nxlf, nxrf, nysf, nynf,                &
6708                                        nys_on_file, nyn_on_file,              &
6709                                        nxl_on_file,nxr_on_file )
6710
6711             CASE ( 't_wall_v(2)' )
6712                IF ( k == 1 )  THEN
6713                   IF ( .NOT.  ALLOCATED( t_wall_v_1(2)%t ) )                  &
6714                      ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1,           &
6715                                                1:surf_usm_v(2)%ns) )
6716                   READ ( 13 )  tmp_wall_v(2)%t
6717                ENDIF
6718                CALL surface_restore_elements(                                 &
6719                                        t_wall_v_1(2)%t, tmp_wall_v(2)%t,      &
6720                                        surf_usm_v(2)%start_index,             & 
6721                                        start_index_on_file,                   &
6722                                        end_index_on_file ,                    &
6723                                        nxlc, nysc,                            &
6724                                        nxlf, nxrf, nysf, nynf,                &
6725                                        nys_on_file, nyn_on_file,              &
6726                                        nxl_on_file,nxr_on_file )
6727
6728             CASE ( 't_wall_v(3)' )
6729                IF ( k == 1 )  THEN
6730                   IF ( .NOT.  ALLOCATED( t_wall_v_1(3)%t ) )                  &
6731                      ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1,           &
6732                                                1:surf_usm_v(3)%ns) )
6733                   READ ( 13 )  tmp_wall_v(3)%t
6734                ENDIF
6735                CALL surface_restore_elements(                                 &
6736                                        t_wall_v_1(3)%t, tmp_wall_v(3)%t,      &
6737                                        surf_usm_v(3)%start_index,             &   
6738                                        start_index_on_file,                   &
6739                                        end_index_on_file,                     &
6740                                        nxlc, nysc,                            &
6741                                        nxlf, nxrf, nysf, nynf,                &
6742                                        nys_on_file, nyn_on_file,              &
6743                                        nxl_on_file,nxr_on_file )
6744
6745             CASE ( 't_green_h' )
6746                IF ( k == 1 )  THEN
6747                   IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                      &
6748                      ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1,               &
6749                                            1:surf_usm_h%ns) )
6750                   READ ( 13 )  tmp_green_h
6751                ENDIF
6752                CALL surface_restore_elements(                                 &
6753                                        t_green_h_1, tmp_green_h,              &
6754                                        surf_usm_h%start_index,                & 
6755                                        start_index_on_file,                   &
6756                                        end_index_on_file,                     &
6757                                        nxlc, nysc,                            &
6758                                        nxlf, nxrf, nysf, nynf,                &
6759                                        nys_on_file, nyn_on_file,              &
6760                                        nxl_on_file,nxr_on_file )
6761
6762             CASE ( 't_green_v(0)' )
6763                IF ( k == 1 )  THEN
6764                   IF ( .NOT.  ALLOCATED( t_green_v_1(0)%t ) )                 &
6765                      ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1,          &
6766                                                 1:surf_usm_v(0)%ns) )
6767                   READ ( 13 )  tmp_green_v(0)%t
6768                ENDIF
6769                CALL surface_restore_elements(                                 &
6770                                        t_green_v_1(0)%t, tmp_green_v(0)%t,    &
6771                                        surf_usm_v(0)%start_index,             & 
6772                                        start_index_on_file,                   &
6773                                        end_index_on_file,                     &
6774                                        nxlc, nysc,                            &
6775                                        nxlf, nxrf, nysf, nynf,                &
6776                                        nys_on_file, nyn_on_file,              &
6777                                        nxl_on_file,nxr_on_file )
6778
6779             CASE ( 't_green_v(1)' )
6780                IF ( k == 1 )  THEN
6781                   IF ( .NOT.  ALLOCATED( t_green_v_1(1)%t ) )                 &
6782                      ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1,          &
6783                                                 1:surf_usm_v(1)%ns) )
6784                   READ ( 13 )  tmp_green_v(1)%t
6785                ENDIF
6786                CALL surface_restore_elements(                                 &
6787                                        t_green_v_1(1)%t, tmp_green_v(1)%t,    &
6788                                        surf_usm_v(1)%start_index,             & 
6789                                        start_index_on_file,                   &
6790                                        end_index_on_file,                     &
6791                                        nxlc, nysc,                            &
6792                                        nxlf, nxrf, nysf, nynf,                &
6793                                        nys_on_file, nyn_on_file,              &
6794                                        nxl_on_file,nxr_on_file )
6795
6796             CASE ( 't_green_v(2)' )
6797                IF ( k == 1 )  THEN
6798                   IF ( .NOT.  ALLOCATED( t_green_v_1(2)%t ) )                 &
6799                      ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1,          &
6800                                                 1:surf_usm_v(2)%ns) )
6801                   READ ( 13 )  tmp_green_v(2)%t
6802                ENDIF
6803                CALL surface_restore_elements(                                 &
6804                                        t_green_v_1(2)%t, tmp_green_v(2)%t,    &
6805                                        surf_usm_v(2)%start_index,             & 
6806                                        start_index_on_file,                   &
6807                                        end_index_on_file ,                    &
6808                                        nxlc, nysc,                            &
6809                                        nxlf, nxrf, nysf, nynf,                &
6810                                        nys_on_file, nyn_on_file,              &
6811                                        nxl_on_file,nxr_on_file )
6812
6813             CASE ( 't_green_v(3)' )
6814                IF ( k == 1 )  THEN
6815                   IF ( .NOT.  ALLOCATED( t_green_v_1(3)%t ) )                 &
6816                      ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1,          &
6817                                                 1:surf_usm_v(3)%ns) )
6818                   READ ( 13 )  tmp_green_v(3)%t
6819                ENDIF
6820                CALL surface_restore_elements(                                 &
6821                                        t_green_v_1(3)%t, tmp_green_v(3)%t,    &
6822                                        surf_usm_v(3)%start_index,             & 
6823                                        start_index_on_file,                   &
6824                                        end_index_on_file,                     &
6825                                        nxlc, nysc,                            &
6826                                        nxlf, nxrf, nysf, nynf,                &
6827                                        nys_on_file, nyn_on_file,              &
6828                                        nxl_on_file,nxr_on_file )
6829
6830             CASE ( 't_window_h' )
6831                IF ( k == 1 )  THEN
6832                   IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                     &
6833                      ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1,              &
6834                                             1:surf_usm_h%ns) )
6835                   READ ( 13 )  tmp_window_h
6836                ENDIF
6837                CALL surface_restore_elements(                                 &
6838                                        t_window_h_1, tmp_window_h,            &
6839                                        surf_usm_h%start_index,                & 
6840                                        start_index_on_file,                   &
6841                                        end_index_on_file,                     &
6842                                        nxlc, nysc,                            &
6843                                        nxlf, nxrf, nysf, nynf,                &
6844                                        nys_on_file, nyn_on_file,              &
6845                                        nxl_on_file, nxr_on_file )
6846
6847             CASE ( 't_window_v(0)' )
6848                IF ( k == 1 )  THEN
6849                   IF ( .NOT.  ALLOCATED( t_window_v_1(0)%t ) )                &
6850                      ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1,         &
6851                                                  1:surf_usm_v(0)%ns) )
6852                   READ ( 13 )  tmp_window_v(0)%t
6853                ENDIF
6854                CALL surface_restore_elements(                                 &
6855                                        t_window_v_1(0)%t,                     & 
6856                                        tmp_window_v(0)%t,                     &
6857                                        surf_usm_v(0)%start_index,             &
6858                                        start_index_on_file,                   &
6859                                        end_index_on_file,                     &
6860                                        nxlc, nysc,                            &
6861                                        nxlf, nxrf, nysf, nynf,                &
6862                                        nys_on_file, nyn_on_file,              &
6863                                        nxl_on_file,nxr_on_file )
6864
6865             CASE ( 't_window_v(1)' )
6866                IF ( k == 1 )  THEN
6867                   IF ( .NOT.  ALLOCATED( t_window_v_1(1)%t ) )                &
6868                      ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1,         &
6869                                                  1:surf_usm_v(1)%ns) )
6870                   READ ( 13 )  tmp_window_v(1)%t
6871                ENDIF
6872                CALL surface_restore_elements(                                 &
6873                                        t_window_v_1(1)%t,                     & 
6874                                        tmp_window_v(1)%t,                     &
6875                                        surf_usm_v(1)%start_index,             & 
6876                                        start_index_on_file,                   &
6877                                        end_index_on_file,                     &
6878                                        nxlc, nysc,                            &
6879                                        nxlf, nxrf, nysf, nynf,                &
6880                                        nys_on_file, nyn_on_file,              &
6881                                        nxl_on_file,nxr_on_file )
6882
6883             CASE ( 't_window_v(2)' )
6884                IF ( k == 1 )  THEN
6885                   IF ( .NOT.  ALLOCATED( t_window_v_1(2)%t ) )                &
6886                      ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1,         &
6887                                                  1:surf_usm_v(2)%ns) )
6888                   READ ( 13 )  tmp_window_v(2)%t
6889                ENDIF
6890                CALL surface_restore_elements(                                 &
6891                                        t_window_v_1(2)%t,                     & 
6892                                        tmp_window_v(2)%t,                     &
6893                                        surf_usm_v(2)%start_index,             & 
6894                                        start_index_on_file,                   &
6895                                        end_index_on_file ,                    &
6896                                        nxlc, nysc,                            &
6897                                        nxlf, nxrf, nysf, nynf,                &
6898                                        nys_on_file, nyn_on_file,              &
6899                                        nxl_on_file,nxr_on_file )
6900
6901             CASE ( 't_window_v(3)' )
6902                IF ( k == 1 )  THEN
6903                   IF ( .NOT.  ALLOCATED( t_window_v_1(3)%t ) )                &
6904                      ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
6905                   READ ( 13 )  tmp_window_v(3)%t
6906                ENDIF
6907                CALL surface_restore_elements(                                 &
6908                                        t_window_v_1(3)%t,                     & 
6909                                        tmp_window_v(3)%t,                     &
6910                                        surf_usm_v(3)%start_index,             & 
6911                                        start_index_on_file,                   &
6912                                        end_index_on_file,                     &
6913                                        nxlc, nysc,                            &
6914                                        nxlf, nxrf, nysf, nynf,                &
6915                                        nys_on_file, nyn_on_file,              &
6916                                        nxl_on_file,nxr_on_file )
6917
6918             CASE DEFAULT
6919
6920                   found = .FALSE.
6921
6922          END SELECT
6923
6924       
6925    END SUBROUTINE usm_rrd_local
6926
6927   
6928!------------------------------------------------------------------------------!
6929! Description:
6930! ------------
6931!
6932!> This subroutine reads walls, roofs and land categories and it parameters
6933!> from input files.
6934!------------------------------------------------------------------------------!
6935    SUBROUTINE usm_read_urban_surface_types
6936   
6937        USE netcdf_data_input_mod,                                             &
6938            ONLY:  building_pars_f, building_type_f
6939
6940        IMPLICIT NONE
6941
6942        CHARACTER(12)                                         :: wtn
6943        INTEGER(iwp)                                          :: wtc
6944        REAL(wp), DIMENSION(n_surface_params)                 :: wtp
6945        LOGICAL                                               :: ascii_file = .FALSE.
6946        INTEGER(iwp), DIMENSION(0:17, nysg:nyng, nxlg:nxrg)   :: usm_par
6947        REAL(wp), DIMENSION(1:14, nysg:nyng, nxlg:nxrg)       :: usm_val
6948        INTEGER(iwp)                                          :: k, l, iw, jw, kw, it, ip, ii, ij, m
6949        INTEGER(iwp)                                          :: i, j
6950        INTEGER(iwp)                                          :: nz, roof, dirwe, dirsn
6951        INTEGER(iwp)                                          :: category
6952        INTEGER(iwp)                                          :: weheight1, wecat1, snheight1, sncat1
6953        INTEGER(iwp)                                          :: weheight2, wecat2, snheight2, sncat2
6954        INTEGER(iwp)                                          :: weheight3, wecat3, snheight3, sncat3
6955        REAL(wp)                                              :: height, albedo, thick
6956        REAL(wp)                                              :: wealbedo1, wethick1, snalbedo1, snthick1
6957        REAL(wp)                                              :: wealbedo2, wethick2, snalbedo2, snthick2
6958        REAL(wp)                                              :: wealbedo3, wethick3, snalbedo3, snthick3
6959
6960
6961        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'start' )
6962!
6963!--     If building_pars or building_type are already read from static input
6964!--     file, skip reading ASCII file.
6965        IF ( building_type_f%from_file  .OR.  building_pars_f%from_file )      &
6966           RETURN
6967!
6968!--     Check if ASCII input file exists. If not, return and initialize USM
6969!--     with default settings.
6970        INQUIRE( FILE = 'SURFACE_PARAMETERS' // coupling_char,                 &
6971                 EXIST = ascii_file )
6972                 
6973        IF ( .NOT. ascii_file )  RETURN
6974
6975!
6976!--     read categories of walls and their parameters
6977        DO  ii = 0, io_blocks-1
6978            IF ( ii == io_group )  THEN
6979!
6980!--             open urban surface file
6981                OPEN( 151, file='SURFACE_PARAMETERS'//coupling_char, action='read', &
6982                           status='old', form='formatted', err=15 )
6983!
6984!--             first test and get n_surface_types
6985                k = 0
6986                l = 0
6987                DO
6988                    l = l+1
6989                    READ( 151, *, err=11, end=12 )  wtc, wtp, wtn
6990                    k = k+1
6991                    CYCLE
6992 11                 CONTINUE
6993                ENDDO
6994 12             n_surface_types = k
6995                ALLOCATE( surface_type_names(n_surface_types) )
6996                ALLOCATE( surface_type_codes(n_surface_types) )
6997                ALLOCATE( surface_params(n_surface_params, n_surface_types) )
6998!
6999!--             real reading
7000                rewind( 151 )
7001                k = 0
7002                DO
7003                    READ( 151, *, err=13, end=14 )  wtc, wtp, wtn
7004                    k = k+1
7005                    surface_type_codes(k) = wtc
7006                    surface_params(:,k) = wtp
7007                    surface_type_names(k) = wtn
7008                    CYCLE
700913                  WRITE(6,'(i3,a,2i5)') myid, 'readparams2 error k=', k
7010                    FLUSH(6)
7011                    CONTINUE
7012                ENDDO
7013 14             CLOSE(151)
7014                CYCLE
7015 15             message_string = 'file SURFACE_PARAMETERS'//TRIM(coupling_char)//' does not exist'
7016                CALL message( 'usm_read_urban_surface_types', 'PA0513', 1, 2, 0, 6, 0 )
7017            ENDIF
7018        ENDDO
7019   
7020!
7021!--     read types of surfaces
7022        usm_par = 0
7023        DO  ii = 0, io_blocks-1
7024            IF ( ii == io_group )  THEN
7025
7026!
7027!--             open csv urban surface file
7028                OPEN( 151, file='URBAN_SURFACE'//TRIM(coupling_char), action='read', &
7029                      status='old', form='formatted', err=23 )
7030               
7031                l = 0
7032                DO
7033                    l = l+1
7034!
7035!--                 i, j, height, nz, roof, dirwe, dirsn, category, soilcat,
7036!--                 weheight1, wecat1, snheight1, sncat1, weheight2, wecat2, snheight2, sncat2,
7037!--                 weheight3, wecat3, snheight3, sncat3
7038                    READ( 151, *, err=21, end=25 )  i, j, height, nz, roof, dirwe, dirsn,            &
7039                                            category, albedo, thick,                                 &
7040                                            weheight1, wecat1, wealbedo1, wethick1,                  &
7041                                            weheight2, wecat2, wealbedo2, wethick2,                  &
7042                                            weheight3, wecat3, wealbedo3, wethick3,                  &
7043                                            snheight1, sncat1, snalbedo1, snthick1,                  &
7044                                            snheight2, sncat2, snalbedo2, snthick2,                  &
7045                                            snheight3, sncat3, snalbedo3, snthick3
7046
7047                    IF ( i >= nxlg  .AND.  i <= nxrg  .AND.  j >= nysg  .AND.  j <= nyng )  THEN
7048!
7049!--                     write integer variables into array
7050                        usm_par(:,j,i) = (/1, nz, roof, dirwe, dirsn, category,                      &
7051                                          weheight1, wecat1, weheight2, wecat2, weheight3, wecat3,   &
7052                                          snheight1, sncat1, snheight2, sncat2, snheight3, sncat3 /)
7053!
7054!--                     write real values into array
7055                        usm_val(:,j,i) = (/ albedo, thick,                                           &
7056                                           wealbedo1, wethick1, wealbedo2, wethick2,                 &
7057                                           wealbedo3, wethick3, snalbedo1, snthick1,                 &
7058                                           snalbedo2, snthick2, snalbedo3, snthick3 /)
7059                    ENDIF
7060                    CYCLE
7061 21                 WRITE (message_string, "(A,I5)") 'errors in file URBAN_SURFACE'//TRIM(coupling_char)//' on line ', l
7062                    CALL message( 'usm_read_urban_surface_types', 'PA0512', 0, 1, 0, 6, 0 )
7063                ENDDO
7064         
7065 23             message_string = 'file URBAN_SURFACE'//TRIM(coupling_char)//' does not exist'
7066                CALL message( 'usm_read_urban_surface_types', 'PA0514', 1, 2, 0, 6, 0 )
7067
7068 25             CLOSE( 151 )
7069
7070            ENDIF
7071#if defined( __parallel )
7072            CALL MPI_BARRIER( comm2d, ierr )
7073#endif
7074        ENDDO
7075       
7076!
7077!--     check completeness and formal correctness of the data
7078        DO i = nxlg, nxrg
7079            DO j = nysg, nyng
7080                IF ( usm_par(0,j,i) /= 0  .AND.  (        &  !< incomplete data,supply default values later
7081                     usm_par(1,j,i) < nzb  .OR.           &
7082                     usm_par(1,j,i) > nzt  .OR.           &  !< incorrect height (nz < nzb  .OR.  nz > nzt)
7083                     usm_par(2,j,i) < 0  .OR.             &
7084                     usm_par(2,j,i) > 1  .OR.             &  !< incorrect roof sign
7085                     usm_par(3,j,i) < nzb-nzt  .OR.       & 
7086                     usm_par(3,j,i) > nzt-nzb  .OR.       &  !< incorrect west-east wall direction sign
7087                     usm_par(4,j,i) < nzb-nzt  .OR.       &
7088                     usm_par(4,j,i) > nzt-nzb  .OR.       &  !< incorrect south-north wall direction sign
7089                     usm_par(6,j,i) < nzb  .OR.           & 
7090                     usm_par(6,j,i) > nzt  .OR.           &  !< incorrect pedestrian level height for west-east wall
7091                     usm_par(8,j,i) > nzt  .OR.           &
7092                     usm_par(10,j,i) > nzt  .OR.          &  !< incorrect wall or roof level height for west-east wall
7093                     usm_par(12,j,i) < nzb  .OR.          & 
7094                     usm_par(12,j,i) > nzt  .OR.          &  !< incorrect pedestrian level height for south-north wall
7095                     usm_par(14,j,i) > nzt  .OR.          &
7096                     usm_par(16,j,i) > nzt                &  !< incorrect wall or roof level height for south-north wall
7097                    ) )  THEN
7098!
7099!--                 incorrect input data
7100                    WRITE (message_string, "(A,2I5)") 'missing or incorrect data in file URBAN_SURFACE'// &
7101                                                       TRIM(coupling_char)//' for i,j=', i,j
7102                    CALL message( 'usm_read_urban_surface', 'PA0504', 1, 2, 0, 6, 0 )
7103                ENDIF
7104               
7105            ENDDO
7106        ENDDO
7107!       
7108!--     Assign the surface types to the respective data type.
7109!--     First, for horizontal upward-facing surfaces.
7110!--     Further, set flag indicating that albedo is initialized via ASCII
7111!--     format, else it would be overwritten in the radiation model.
7112        surf_usm_h%albedo_from_ascii = .TRUE.
7113        DO  m = 1, surf_usm_h%ns
7114           iw = surf_usm_h%i(m)
7115           jw = surf_usm_h%j(m)
7116           kw = surf_usm_h%k(m)
7117
7118           IF ( usm_par(5,jw,iw) == 0 )  THEN
7119
7120              IF ( zu(kw) >= roof_height_limit )  THEN
7121                 surf_usm_h%isroof_surf(m)   = .TRUE.
7122                 surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
7123              ELSE
7124                 surf_usm_h%isroof_surf(m)   = .FALSE.
7125                 surf_usm_h%surface_types(m) = land_category         !< default category for land surface
7126              ENDIF
7127
7128              surf_usm_h%albedo(:,m)    = -1.0_wp
7129              surf_usm_h%thickness_wall(m) = -1.0_wp
7130              surf_usm_h%thickness_green(m) = -1.0_wp
7131              surf_usm_h%thickness_window(m) = -1.0_wp
7132           ELSE
7133              IF ( usm_par(2,jw,iw)==0 )  THEN
7134                 surf_usm_h%isroof_surf(m)    = .FALSE.
7135                 surf_usm_h%thickness_wall(m) = -1.0_wp
7136                 surf_usm_h%thickness_window(m) = -1.0_wp
7137                 surf_usm_h%thickness_green(m)  = -1.0_wp
7138              ELSE
7139                 surf_usm_h%isroof_surf(m)    = .TRUE.
7140                 surf_usm_h%thickness_wall(m) = usm_val(2,jw,iw)
7141                 surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
7142                 surf_usm_h%thickness_green(m)  = usm_val(2,jw,iw)
7143              ENDIF
7144              surf_usm_h%surface_types(m) = usm_par(5,jw,iw)
7145              surf_usm_h%albedo(:,m)   = usm_val(1,jw,iw)
7146              surf_usm_h%transmissivity(m)    = 0.0_wp
7147           ENDIF
7148!
7149!--        Find the type position
7150           it = surf_usm_h%surface_types(m)
7151           ip = -99999
7152           DO k = 1, n_surface_types
7153              IF ( surface_type_codes(k) == it )  THEN
7154                 ip = k
7155                 EXIT
7156              ENDIF
7157           ENDDO
7158           IF ( ip == -99999 )  THEN
7159!
7160!--           land/roof category not found
7161              WRITE (9,"(A,I5,A,3I5)") 'land/roof category ', it,     &
7162                                       ' not found  for i,j,k=', iw,jw,kw
7163              FLUSH(9)
7164              IF ( surf_usm_h%isroof_surf(m) ) THEN
7165                 category = roof_category
7166              ELSE
7167                 category = land_category
7168              ENDIF
7169              DO k = 1, n_surface_types
7170                 IF ( surface_type_codes(k) == roof_category ) THEN
7171                    ip = k
7172                    EXIT
7173                 ENDIF
7174              ENDDO
7175              IF ( ip == -99999 )  THEN
7176!
7177!--              default land/roof category not found
7178                 WRITE (9,"(A,I5,A,3I5)") 'Default land/roof category', category, ' not found!'
7179                 FLUSH(9)
7180                 ip = 1
7181              ENDIF
7182           ENDIF
7183!
7184!--        Albedo
7185           IF ( surf_usm_h%albedo(ind_veg_wall,m) < 0.0_wp )  THEN
7186              surf_usm_h%albedo(:,m) = surface_params(ialbedo,ip)
7187           ENDIF
7188!
7189!--        Albedo type is 0 (custom), others are replaced later
7190           surf_usm_h%albedo_type(:,m) = 0
7191!
7192!--        Transmissivity
7193           IF ( surf_usm_h%transmissivity(m) < 0.0_wp )  THEN
7194              surf_usm_h%transmissivity(m) = 0.0_wp
7195           ENDIF
7196!
7197!--        emissivity of the wall
7198           surf_usm_h%emissivity(:,m) = surface_params(iemiss,ip)
7199!           
7200!--        heat conductivity λS between air and wall ( W m−2 K−1 )
7201           surf_usm_h%lambda_surf(m) = surface_params(ilambdas,ip)
7202           surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
7203           surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
7204!           
7205!--        roughness length for momentum, heat and humidity
7206           surf_usm_h%z0(m) = surface_params(irough,ip)
7207           surf_usm_h%z0h(m) = surface_params(iroughh,ip)
7208           surf_usm_h%z0q(m) = surface_params(iroughh,ip)
7209!
7210!--        Surface skin layer heat capacity (J m−2 K−1 )
7211           surf_usm_h%c_surface(m) = surface_params(icsurf,ip)
7212           surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
7213           surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
7214!           
7215!--        wall material parameters:
7216!--        thickness of the wall (m)
7217!--        missing values are replaced by default value for category
7218           IF ( surf_usm_h%thickness_wall(m) <= 0.001_wp )  THEN
7219                surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
7220           ENDIF
7221           IF ( surf_usm_h%thickness_window(m) <= 0.001_wp )  THEN
7222                surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
7223           ENDIF
7224           IF ( surf_usm_h%thickness_green(m) <= 0.001_wp )  THEN
7225                surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
7226           ENDIF
7227!           
7228!--        volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
7229           surf_usm_h%rho_c_wall(:,m) = surface_params(irhoC,ip)
7230           surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
7231           surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
7232!           
7233!--        thermal conductivity λH of the wall (W m−1 K−1 )
7234           surf_usm_h%lambda_h(:,m) = surface_params(ilambdah,ip)
7235           surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7236           surf_usm_h%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
7237
7238        ENDDO
7239!
7240!--     For vertical surface elements ( 0 -- northward-facing, 1 -- southward-facing,
7241!--     2 -- eastward-facing, 3 -- westward-facing )
7242        DO  l = 0, 3
7243!
7244!--        Set flag indicating that albedo is initialized via ASCII format.
7245!--        Else it would be overwritten in the radiation model.
7246           surf_usm_v(l)%albedo_from_ascii = .TRUE.
7247           DO  m = 1, surf_usm_v(l)%ns
7248              i  = surf_usm_v(l)%i(m)
7249              j  = surf_usm_v(l)%j(m)
7250              kw = surf_usm_v(l)%k(m)
7251             
7252              IF ( l == 3 )  THEN ! westward facing
7253                 iw = i
7254                 jw = j
7255                 ii = 6
7256                 ij = 3
7257              ELSEIF ( l == 2 )  THEN
7258                 iw = i-1
7259                 jw = j
7260                 ii = 6
7261                 ij = 3
7262              ELSEIF ( l == 1 )  THEN
7263                 iw = i
7264                 jw = j
7265                 ii = 12
7266                 ij = 9
7267              ELSEIF ( l == 0 )  THEN
7268                 iw = i
7269                 jw = j-1
7270                 ii = 12
7271                 ij = 9
7272              ENDIF
7273
7274              IF ( iw < 0 .OR. jw < 0 ) THEN
7275!
7276!--              wall on west or south border of the domain - assign default category
7277                 IF ( kw <= roof_height_limit ) THEN
7278                     surf_usm_v(l)%surface_types(m) = wall_category   !< default category for wall surface in wall zone
7279                 ELSE
7280                     surf_usm_v(l)%surface_types(m) = roof_category   !< default category for wall surface in roof zone
7281                 END IF
7282                 surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7283                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7284                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7285                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7286                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7287              ELSE IF ( kw <= usm_par(ii,jw,iw) )  THEN
7288!
7289!--                 pedestrian zone
7290                 IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
7291                     surf_usm_v(l)%surface_types(m)  = pedestrian_category   !< default category for wall surface in
7292                                                                             !<pedestrian zone
7293                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7294                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7295                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7296                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7297                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7298                 ELSE
7299                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+1,jw,iw)
7300                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij,jw,iw)
7301                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+1,jw,iw)
7302                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+1,jw,iw)
7303                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+1,jw,iw)
7304                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7305                 ENDIF
7306              ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
7307!
7308!--              wall zone
7309                 IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
7310                     surf_usm_v(l)%surface_types(m)    = wall_category         !< default category for wall surface
7311                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7312                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7313                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7314                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7315                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7316                 ELSE
7317                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+3,jw,iw)
7318                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij+2,jw,iw)
7319                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+3,jw,iw)
7320                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+3,jw,iw)
7321                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+3,jw,iw)
7322                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7323                 ENDIF
7324              ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
7325!
7326!--              roof zone
7327                 IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
7328                     surf_usm_v(l)%surface_types(m)    = roof_category         !< default category for roof surface
7329                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7330                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7331                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7332                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7333                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7334                 ELSE
7335                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+5,jw,iw)
7336                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij+4,jw,iw)
7337                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+5,jw,iw)
7338                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+5,jw,iw)
7339                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+5,jw,iw)
7340                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7341                 ENDIF
7342              ELSE
7343                 WRITE(9,*) 'Problem reading USM data:'
7344                 WRITE(9,*) l,i,j,kw,get_topography_top_index_ji( j, i, 's' )
7345                 WRITE(9,*) ii,iw,jw,kw,get_topography_top_index_ji( jw, iw, 's' )
7346                 WRITE(9,*) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw)
7347                 WRITE(9,*) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw)
7348                 WRITE(9,*) usm_par(ii+4,jw,iw),usm_par(ii+5,jw,iw)
7349                 WRITE(9,*) kw,roof_height_limit,wall_category,roof_category
7350                 FLUSH(9)
7351!
7352!--              supply the default category
7353                 IF ( kw <= roof_height_limit ) THEN
7354                     surf_usm_v(l)%surface_types(m) = wall_category   !< default category for wall surface in wall zone
7355                 ELSE
7356                     surf_usm_v(l)%surface_types(m) = roof_category   !< default category for wall surface in roof zone
7357                 END IF
7358                 surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7359                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7360                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7361                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7362                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7363              ENDIF
7364!
7365!--           Find the type position
7366              it = surf_usm_v(l)%surface_types(m)
7367              ip = -99999
7368              DO k = 1, n_surface_types
7369                 IF ( surface_type_codes(k) == it )  THEN
7370                    ip = k
7371                    EXIT
7372                 ENDIF
7373              ENDDO
7374              IF ( ip == -99999 )  THEN
7375!
7376!--              wall category not found
7377                 WRITE (9, "(A,I7,A,3I5)") 'wall category ', it,  &
7378                                           ' not found  for i,j,k=', iw,jw,kw
7379                 FLUSH(9)
7380                 category = wall_category 
7381                 DO k = 1, n_surface_types
7382                    IF ( surface_type_codes(k) == category ) THEN
7383                       ip = k
7384                       EXIT
7385                    ENDIF
7386                 ENDDO
7387                 IF ( ip == -99999 )  THEN
7388!
7389!--                 default wall category not found
7390                    WRITE (9, "(A,I5,A,3I5)") 'Default wall category', category, ' not found!'
7391                    FLUSH(9)
7392                    ip = 1
7393                 ENDIF
7394              ENDIF
7395
7396!
7397!--           Albedo
7398              IF ( surf_usm_v(l)%albedo(ind_veg_wall,m) < 0.0_wp )  THEN
7399                 surf_usm_v(l)%albedo(:,m) = surface_params(ialbedo,ip)
7400              ENDIF
7401!--           Albedo type is 0 (custom), others are replaced later
7402              surf_usm_v(l)%albedo_type(:,m) = 0
7403!--           Transmissivity of the windows
7404              IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp )  THEN
7405                 surf_usm_v(l)%transmissivity(m) = 0.0_wp
7406              ENDIF
7407!
7408!--           emissivity of the wall
7409              surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
7410!           
7411!--           heat conductivity lambda S between air and wall ( W m-2 K-1 )
7412              surf_usm_v(l)%lambda_surf(m) = surface_params(ilambdas,ip)
7413              surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
7414              surf_usm_v(l)%lambda_surf_green(m) = surface_params(ilambdas,ip)
7415!           
7416!--           roughness length
7417              surf_usm_v(l)%z0(m) = surface_params(irough,ip)
7418              surf_usm_v(l)%z0h(m) = surface_params(iroughh,ip)
7419              surf_usm_v(l)%z0q(m) = surface_params(iroughh,ip)
7420!           
7421!--           Surface skin layer heat capacity (J m-2 K-1 )
7422              surf_usm_v(l)%c_surface(m) = surface_params(icsurf,ip)
7423              surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
7424              surf_usm_v(l)%c_surface_green(m) = surface_params(icsurf,ip)
7425!           
7426!--           wall material parameters:
7427!--           thickness of the wall (m)
7428!--           missing values are replaced by default value for category
7429              IF ( surf_usm_v(l)%thickness_wall(m) <= 0.001_wp )  THEN
7430                   surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
7431              ENDIF
7432              IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp )  THEN
7433                   surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
7434              ENDIF
7435              IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp )  THEN
7436                   surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
7437              ENDIF
7438!
7439!--           volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
7440              surf_usm_v(l)%rho_c_wall(:,m) = surface_params(irhoC,ip)
7441              surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
7442              surf_usm_v(l)%rho_c_green(:,m) = surface_params(irhoC,ip)
7443!           
7444!--           thermal conductivity lambda H of the wall (W m-1 K-1 )
7445              surf_usm_v(l)%lambda_h(:,m) = surface_params(ilambdah,ip)
7446              surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7447              surf_usm_v(l)%lambda_h_green(:,m) = surface_params(ilambdah,ip)
7448
7449           ENDDO
7450        ENDDO 
7451
7452!
7453!--     Initialize wall layer thicknesses. Please note, this will be removed
7454!--     after migration to Palm input data standard. 
7455        DO k = nzb_wall, nzt_wall
7456           zwn(k) = zwn_default(k)
7457           zwn_green(k) = zwn_default_green(k)
7458           zwn_window(k) = zwn_default_window(k)
7459        ENDDO
7460!
7461!--     apply for all particular surface grids. First for horizontal surfaces
7462        DO  m = 1, surf_usm_h%ns
7463           surf_usm_h%zw(:,m) = zwn(:) * surf_usm_h%thickness_wall(m)
7464           surf_usm_h%zw_green(:,m) = zwn_green(:) * surf_usm_h%thickness_green(m)
7465           surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
7466        ENDDO
7467        DO  l = 0, 3
7468           DO  m = 1, surf_usm_v(l)%ns
7469              surf_usm_v(l)%zw(:,m) = zwn(:) * surf_usm_v(l)%thickness_wall(m)
7470              surf_usm_v(l)%zw_green(:,m) = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
7471              surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
7472           ENDDO
7473        ENDDO
7474
7475        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'end' )
7476   
7477    END SUBROUTINE usm_read_urban_surface_types
7478
7479
7480!------------------------------------------------------------------------------!
7481! Description:
7482! ------------
7483!
7484!> This function advances through the list of local surfaces to find given
7485!> x, y, d, z coordinates
7486!------------------------------------------------------------------------------!
7487    PURE FUNCTION find_surface( x, y, z, d ) result(isurfl)
7488
7489        INTEGER(iwp), INTENT(in)                :: x, y, z, d
7490        INTEGER(iwp)                            :: isurfl
7491        INTEGER(iwp)                            :: isx, isy, isz
7492
7493        IF ( d == 0 ) THEN
7494           DO  isurfl = 1, surf_usm_h%ns
7495              isx = surf_usm_h%i(isurfl)
7496              isy = surf_usm_h%j(isurfl)
7497              isz = surf_usm_h%k(isurfl)
7498              IF ( isx==x .and. isy==y .and. isz==z )  RETURN
7499           ENDDO
7500        ELSE
7501           DO  isurfl = 1, surf_usm_v(d-1)%ns
7502              isx = surf_usm_v(d-1)%i(isurfl)
7503              isy = surf_usm_v(d-1)%j(isurfl)
7504              isz = surf_usm_v(d-1)%k(isurfl)
7505              IF ( isx==x .and. isy==y .and. isz==z )  RETURN
7506           ENDDO
7507        ENDIF
7508!
7509!--     coordinate not found
7510        isurfl = -1
7511
7512    END FUNCTION
7513
7514
7515!------------------------------------------------------------------------------!
7516! Description:
7517! ------------
7518!
7519!> This subroutine reads temperatures of respective material layers in walls,
7520!> roofs and ground from input files. Data in the input file must be in
7521!> standard order, i.e. horizontal surfaces first ordered by x, y and then
7522!> vertical surfaces ordered by x, y, direction, z
7523!------------------------------------------------------------------------------!
7524    SUBROUTINE usm_read_wall_temperature
7525
7526        INTEGER(iwp)                                          :: i, j, k, d, ii, iline  !> running indices
7527        INTEGER(iwp)                                          :: isurfl
7528        REAL(wp)                                              :: rtsurf
7529        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1)              :: rtwall
7530
7531
7532        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'start' )
7533
7534        DO  ii = 0, io_blocks-1
7535            IF ( ii == io_group )  THEN
7536!
7537!--             open wall temperature file
7538                OPEN( 152, file='WALL_TEMPERATURE'//coupling_char, action='read', &
7539                           status='old', form='formatted', err=15 )
7540
7541                isurfl = 0
7542                iline = 1
7543                DO
7544                    rtwall = -9999.0_wp  !< for incomplete lines
7545                    READ( 152, *, err=13, end=14 )  i, j, k, d, rtsurf, rtwall
7546
7547                    IF ( nxl <= i .and. i <= nxr .and. &
7548                        nys <= j .and. j <= nyn)  THEN  !< local processor
7549!--                     identify surface id
7550                        isurfl = find_surface( i, j, k, d )
7551                        IF ( isurfl == -1 )  THEN
7552                            WRITE(message_string, '(a,4i5,a,i5,a)') 'Coordinates (xyzd) ', i, j, k, d, &
7553                                ' on line ', iline, &
7554                                ' in file WALL_TEMPERATURE are either not present or out of standard order of surfaces.'
7555                            CALL message( 'usm_read_wall_temperature', 'PA0521', 1, 2, 0, 6, 0 )
7556                        ENDIF
7557!
7558!--                     assign temperatures
7559                        IF ( d == 0 ) THEN
7560                           t_surf_wall_h(isurfl) = rtsurf
7561                           t_wall_h(:,isurfl) = rtwall(:)
7562                           t_window_h(:,isurfl) = rtwall(:)
7563                           t_green_h(:,isurfl) = rtwall(:)
7564                        ELSE
7565                           t_surf_wall_v(d-1)%t(isurfl) = rtsurf
7566                           t_wall_v(d-1)%t(:,isurfl) = rtwall(:)
7567                           t_window_v(d-1)%t(:,isurfl) = rtwall(:)
7568                           t_green_v(d-1)%t(:,isurfl) = rtwall(:)
7569                        ENDIF
7570                    ENDIF
7571
7572                    iline = iline + 1
7573                    CYCLE
7574 13                 WRITE(message_string, '(a,i5,a)') 'Error reading line ', iline, &
7575                        ' in file WALL_TEMPERATURE.'
7576                    CALL message( 'usm_read_wall_temperature', 'PA0522', 1, 2, 0, 6, 0 )
7577                ENDDO
7578 14             CLOSE(152)
7579                CYCLE
7580 15             message_string = 'file WALL_TEMPERATURE'//TRIM(coupling_char)//' does not exist'
7581                CALL message( 'usm_read_wall_temperature', 'PA0523', 1, 2, 0, 6, 0 )
7582            ENDIF
7583#if defined( __parallel )
7584            CALL MPI_BARRIER( comm2d, ierr )
7585#endif
7586        ENDDO
7587
7588        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'end' )
7589
7590    END SUBROUTINE usm_read_wall_temperature
7591
7592
7593
7594!------------------------------------------------------------------------------!
7595! Description:
7596! ------------
7597!> Solver for the energy balance at the ground/roof/wall surface.
7598!> It follows basic ideas and structure of lsm_energy_balance
7599!> with many simplifications and adjustments.
7600!> TODO better description
7601!> No calculation of window surface temperatures during spinup to increase
7602!> maximum possible timstep
7603!------------------------------------------------------------------------------!
7604    SUBROUTINE usm_surface_energy_balance( spinup )
7605
7606
7607        IMPLICIT NONE
7608
7609        INTEGER(iwp)                          :: i, j, k, l, m   !< running indices
7610       
7611        INTEGER(iwp) ::  i_off     !< offset to determine index of surface element, seen from atmospheric grid point, for x
7612        INTEGER(iwp) ::  j_off     !< offset to determine index of surface element, seen from atmospheric grid point, for y
7613        INTEGER(iwp) ::  k_off     !< offset to determine index of surface element, seen from atmospheric grid point, for z
7614
7615        LOGICAL                               :: spinup             !true during spinup
7616       
7617        REAL(wp)                              :: stend_wall         !< surface tendency
7618       
7619        REAL(wp)                              :: stend_window       !< surface tendency
7620        REAL(wp)                              :: stend_green        !< surface tendency
7621        REAL(wp)                              :: coef_1             !< first coeficient for prognostic equation
7622        REAL(wp)                              :: coef_window_1      !< first coeficient for prognostic window equation
7623        REAL(wp)                              :: coef_green_1       !< first coeficient for prognostic green wall equation
7624        REAL(wp)                              :: coef_2             !< second  coeficient for prognostic equation
7625        REAL(wp)                              :: coef_window_2      !< second  coeficient for prognostic window equation
7626        REAL(wp)                              :: coef_green_2       !< second  coeficient for prognostic green wall equation
7627        REAL(wp)                              :: rho_cp             !< rho_wall_surface * c_p
7628        REAL(wp)                              :: f_shf              !< factor for shf_eb
7629        REAL(wp)                              :: f_shf_window       !< factor for shf_eb window
7630        REAL(wp)                              :: f_shf_green        !< factor for shf_eb green wall
7631        REAL(wp)                              :: lambda_surface     !< current value of lambda_surface (heat conductivity
7632                                                                    !<between air and wall)
7633        REAL(wp)                              :: lambda_surface_window  !< current value of lambda_surface (heat conductivity
7634                                                                        !< between air and window)
7635        REAL(wp)                              :: lambda_surface_green   !< current value of lambda_surface (heat conductivity
7636                                                                        !< between air and greeb wall)
7637       
7638        REAL(wp)                              :: dtime              !< simulated time of day (in UTC)
7639        INTEGER(iwp)                          :: dhour              !< simulated hour of day (in UTC)
7640        REAL(wp)                              :: acoef              !< actual coefficient of diurnal profile of anthropogenic heat
7641        REAL(wp) ::  f1,          &  !< resistance correction term 1
7642                     f2,          &  !< resistance correction term 2
7643                     f3,          &  !< resistance correction term 3
7644                     e,           &  !< water vapour pressure
7645                     e_s,         &  !< water vapour saturation pressure
7646                     e_s_dt,      &  !< derivate of e_s with respect to T
7647                     tend,        &  !< tendency
7648                     dq_s_dt,     &  !< derivate of q_s with respect to T
7649                     f_qsws,      &  !< factor for qsws
7650                     f_qsws_veg,  &  !< factor for qsws_veg
7651                     f_qsws_liq,  &  !< factor for qsws_liq
7652                     m_liq_max,   &  !< maxmimum value of the liq. water reservoir
7653                     qv1,         &  !< specific humidity at first grid level
7654                     m_max_depth = 0.0002_wp, &  !< Maximum capacity of the water reservoir (m)
7655                     rho_lv,      &  !< frequently used parameter for green layers
7656                     drho_l_lv,   &  !< frequently used parameter for green layers
7657                     q_s             !< saturation specific humidity
7658
7659
7660        IF ( debug_output )  THEN
7661           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
7662           CALL debug_message( debug_string, 'start' )
7663        ENDIF
7664!
7665!--     Index offset of surface element point with respect to adjoining
7666!--     atmospheric grid point
7667        k_off = surf_usm_h%koff
7668        j_off = surf_usm_h%joff
7669        i_off = surf_usm_h%ioff
7670       
7671!       
7672!--     First, treat horizontal surface elements
7673        !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_surface, lambda_surface_window,                 &
7674        !$OMP&                  lambda_surface_green, qv1, rho_cp, rho_lv, drho_l_lv, f_shf,       &
7675        !$OMP&                  f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, f3, f_qsws_veg,&
7676        !$OMP&                  q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, coef_window_1,   &
7677        !$OMP&                  coef_green_1, coef_2, coef_window_2, coef_green_2, stend_wall,     &
7678        !$OMP&                  stend_window, stend_green, tend, m_liq_max)
7679        !$OMP DO SCHEDULE (STATIC)
7680        DO  m = 1, surf_usm_h%ns
7681!
7682!--        Get indices of respective grid point
7683           i = surf_usm_h%i(m)
7684           j = surf_usm_h%j(m)
7685           k = surf_usm_h%k(m)
7686!
7687!--        TODO - how to calculate lambda_surface for horizontal surfaces
7688!--        (lambda_surface is set according to stratification in land surface model)
7689!--        MS: ???
7690           IF ( surf_usm_h%ol(m) >= 0.0_wp )  THEN
7691              lambda_surface = surf_usm_h%lambda_surf(m)
7692              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7693              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7694           ELSE
7695              lambda_surface = surf_usm_h%lambda_surf(m)
7696              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7697              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7698           ENDIF
7699
7700!            pt1  = pt(k,j,i)
7701           IF ( humidity )  THEN
7702              qv1 = q(k,j,i)
7703           ELSE
7704              qv1 = 0.0_wp
7705           ENDIF
7706!
7707!--        calculate rho * c_p coefficient at surface layer
7708           rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exner(k) )
7709
7710           IF ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp )  THEN
7711!
7712!--           Calculate frequently used parameters
7713              rho_lv    = rho_cp / c_p * l_v
7714              drho_l_lv = 1.0_wp / (rho_l * l_v)
7715           ENDIF
7716
7717!
7718!--        Calculate aerodyamic resistance.
7719!--        Calculation for horizontal surfaces follows LSM formulation
7720!--        pt, us, ts are not available for the prognostic time step,
7721!--        data from the last time step is used here.
7722!
7723!--        Workaround: use single r_a as stability is only treated for the
7724!--        average temperature
7725           surf_usm_h%r_a(m) = ( surf_usm_h%pt1(m) - surf_usm_h%pt_surface(m) ) /&
7726                               ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )   
7727           surf_usm_h%r_a_window(m) = surf_usm_h%r_a(m)
7728           surf_usm_h%r_a_green(m)  = surf_usm_h%r_a(m)
7729
7730!            r_a = ( surf_usm_h%pt1(m) - t_surf_h(m) / exner(k) ) /                              &
7731!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7732!            r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exner(k) ) /                &
7733!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7734!            r_a_green = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /                  &
7735!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7736               
7737!--        Make sure that the resistance does not drop to zero
7738           IF ( surf_usm_h%r_a(m)        < 1.0_wp )                            &
7739               surf_usm_h%r_a(m)        = 1.0_wp
7740           IF ( surf_usm_h%r_a_green(m)  < 1.0_wp )                            &
7741               surf_usm_h%r_a_green(m)  = 1.0_wp
7742           IF ( surf_usm_h%r_a_window(m) < 1.0_wp )                            &
7743               surf_usm_h%r_a_window(m) = 1.0_wp
7744             
7745!
7746!--        Make sure that the resistacne does not exceed a maxmium value in case
7747!--        of zero velocities
7748           IF ( surf_usm_h%r_a(m)        > 300.0_wp )                          &
7749               surf_usm_h%r_a(m)        = 300.0_wp
7750           IF ( surf_usm_h%r_a_green(m)  > 300.0_wp )                          &
7751               surf_usm_h%r_a_green(m)  = 300.0_wp
7752           IF ( surf_usm_h%r_a_window(m) > 300.0_wp )                          &
7753               surf_usm_h%r_a_window(m) = 300.0_wp               
7754               
7755!
7756!--        factor for shf_eb
7757           f_shf  = rho_cp / surf_usm_h%r_a(m)
7758           f_shf_window  = rho_cp / surf_usm_h%r_a_window(m)
7759           f_shf_green  = rho_cp / surf_usm_h%r_a_green(m)
7760       
7761
7762           IF ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) THEN
7763!--           Adapted from LSM:
7764!--           Second step: calculate canopy resistance r_canopy
7765!--           f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
7766 
7767!--           f1: correction for incoming shortwave radiation (stomata close at
7768!--           night)
7769              f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 0.05_wp ) / &
7770                               (0.81_wp * (0.004_wp * surf_usm_h%rad_sw_in(m)      &
7771                                + 1.0_wp)) )
7772!
7773!--           f2: correction for soil moisture availability to plants (the
7774!--           integrated soil moisture must thus be considered here)
7775!--           f2 = 0 for very dry soils
7776              m_total = 0.0_wp
7777              DO  k = nzb_wall, nzt_wall+1
7778                  m_total = m_total + rootfr_h(nzb_wall,m)                              &
7779                            * MAX(swc_h(nzb_wall,m),wilt_h(nzb_wall,m))
7780              ENDDO 
7781   
7782              IF ( m_total > wilt_h(nzb_wall,m)  .AND.  m_total < fc_h(nzb_wall,m) )  THEN
7783                 f2 = ( m_total - wilt_h(nzb_wall,m) ) / (fc_h(nzb_wall,m) - wilt_h(nzb_wall,m) )
7784              ELSEIF ( m_total >= fc_h(nzb_wall,m) )  THEN
7785                 f2 = 1.0_wp
7786              ELSE
7787                 f2 = 1.0E-20_wp
7788              ENDIF
7789       
7790!
7791!--          Calculate water vapour pressure at saturation
7792              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_h(m) &
7793                            - 273.16_wp ) / ( t_surf_green_h(m) - 35.86_wp ) )
7794!
7795!--           f3: correction for vapour pressure deficit
7796              IF ( surf_usm_h%g_d(m) /= 0.0_wp )  THEN
7797!
7798!--           Calculate vapour pressure
7799                 e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
7800                 f3 = EXP ( - surf_usm_h%g_d(m) * (e_s - e) )
7801              ELSE
7802                 f3 = 1.0_wp
7803              ENDIF
7804
7805!
7806!--           Calculate canopy resistance. In case that c_veg is 0 (bare soils),
7807!--           this calculation is obsolete, as r_canopy is not used below.
7808!--           To do: check for very dry soil -> r_canopy goes to infinity
7809              surf_usm_h%r_canopy(m) = surf_usm_h%r_canopy_min(m) /                   &
7810                              ( surf_usm_h%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
7811
7812!
7813!--           Calculate the maximum possible liquid water amount on plants and
7814!--           bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is
7815!--           assumed, while paved surfaces might hold up 1 mm of water. The
7816!--           liquid water fraction for paved surfaces is calculated after
7817!--           Noilhan & Planton (1989), while the ECMWF formulation is used for
7818!--           vegetated surfaces and bare soils.
7819              m_liq_max = m_max_depth * ( surf_usm_h%lai(m) )
7820              surf_usm_h%c_liq(m) = MIN( 1.0_wp, ( m_liq_usm_h%var_usm_1d(m) / m_liq_max )**0.67 )
7821!
7822!--           Calculate saturation specific humidity
7823              q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
7824!
7825!--           In case of dewfall, set evapotranspiration to zero
7826!--           All super-saturated water is then removed from the air
7827              IF ( humidity  .AND.  q_s <= qv1 )  THEN
7828                 surf_usm_h%r_canopy(m) = 0.0_wp
7829              ENDIF
7830
7831!
7832!--           Calculate coefficients for the total evapotranspiration
7833!--           In case of water surface, set vegetation and soil fluxes to zero.
7834!--           For pavements, only evaporation of liquid water is possible.
7835              f_qsws_veg  = rho_lv *                                           &
7836                                ( 1.0_wp        - surf_usm_h%c_liq(m)    ) /   &
7837                                ( surf_usm_h%r_a_green(m) + surf_usm_h%r_canopy(m) )
7838              f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m)   /                   &
7839                                  surf_usm_h%r_a_green(m)
7840       
7841              f_qsws = f_qsws_veg + f_qsws_liq
7842!
7843!--           Calculate derivative of q_s for Taylor series expansion
7844              e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_h(m) - 35.86_wp) -   &
7845                               17.269_wp*( t_surf_green_h(m) - 273.16_wp)      &
7846                              / ( t_surf_green_h(m) - 35.86_wp)**2 )
7847       
7848              dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
7849           ENDIF
7850!
7851!--        add LW up so that it can be removed in prognostic equation
7852           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  -                &
7853                                     surf_usm_h%rad_sw_out(m) +                &
7854                                     surf_usm_h%rad_lw_in(m)  -                &
7855                                     surf_usm_h%rad_lw_out(m)
7856!
7857!--     numerator of the prognostic equation
7858!--     Todo: Adjust to tile approach. So far, emissivity for wall (element 0)
7859!--     is used
7860           coef_1 = surf_usm_h%rad_net_l(m) +                                  & 
7861                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_veg_wall,m) * &
7862                                       sigma_sb * t_surf_wall_h(m) ** 4 +      & 
7863                                       f_shf * surf_usm_h%pt1(m) +             &
7864                                       lambda_surface * t_wall_h(nzb_wall,m)
7865           IF ( ( .NOT. spinup ) .AND. (surf_usm_h%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
7866              coef_window_1 = surf_usm_h%rad_net_l(m) +                           & 
7867                      ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_wat_win,m)  &
7868                                          * sigma_sb * t_surf_window_h(m) ** 4 +  & 
7869                                          f_shf_window * surf_usm_h%pt1(m) +      &
7870                                          lambda_surface_window * t_window_h(nzb_wall,m)
7871           ENDIF                 
7872           IF ( ( humidity ) .AND. ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
7873                    coef_green_1 = surf_usm_h%rad_net_l(m) +                                 & 
7874                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb * &
7875                                       t_surf_green_h(m) ** 4 +                  & 
7876                                          f_shf_green * surf_usm_h%pt1(m) + f_qsws * ( qv1 - q_s    &
7877                                          + dq_s_dt * t_surf_green_h(m) )        &
7878                                          +lambda_surface_green * t_green_h(nzb_wall,m)
7879           ELSE
7880           coef_green_1 = surf_usm_h%rad_net_l(m) +                            & 
7881                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_pav_green,m) *&
7882                                       sigma_sb * t_surf_green_h(m) ** 4 +     & 
7883                                       f_shf_green * surf_usm_h%pt1(m) +       &
7884                                       lambda_surface_green * t_green_h(nzb_wall,m)
7885          ENDIF
7886!
7887!--        denominator of the prognostic equation
7888           coef_2 = 4.0_wp * surf_usm_h%emissivity(ind_veg_wall,m) *           &
7889                             sigma_sb * t_surf_wall_h(m) ** 3                  &
7890                           + lambda_surface + f_shf / exner(k)
7891           IF ( ( .NOT. spinup ) .AND. ( surf_usm_h%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
7892              coef_window_2 = 4.0_wp * surf_usm_h%emissivity(ind_wat_win,m) *     &
7893                                sigma_sb * t_surf_window_h(m) ** 3                &
7894                              + lambda_surface_window + f_shf_window / exner(k)
7895           ENDIF
7896           IF ( ( humidity ) .AND. ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
7897              coef_green_2 = 4.0_wp * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb *    &
7898                                t_surf_green_h(m) ** 3 + f_qsws * dq_s_dt                    &
7899                              + lambda_surface_green + f_shf_green / exner(k)
7900           ELSE
7901           coef_green_2 = 4.0_wp * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb *    &
7902                             t_surf_green_h(m) ** 3                                       &
7903                           + lambda_surface_green + f_shf_green / exner(k)
7904           ENDIF
7905!
7906!--        implicit solution when the surface layer has no heat capacity,
7907!--        otherwise use RK3 scheme.
7908           t_surf_wall_h_p(m) = ( coef_1 * dt_3d * tsc(2) +                        &
7909                             surf_usm_h%c_surface(m) * t_surf_wall_h(m) ) /        & 
7910                           ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
7911           IF ((.NOT. spinup).AND.(surf_usm_h%frac(ind_wat_win,m) > 0.0_wp)) THEN
7912              t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) +                        &
7913                                surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) /        & 
7914                              ( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
7915           ENDIF
7916           t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) +                        &
7917                             surf_usm_h%c_surface_green(m) * t_surf_green_h(m) ) /        & 
7918                           ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
7919!
7920!--        add RK3 term
7921           t_surf_wall_h_p(m) = t_surf_wall_h_p(m) + dt_3d * tsc(3) *         &
7922                           surf_usm_h%tt_surface_wall_m(m)
7923
7924           t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) *     &
7925                           surf_usm_h%tt_surface_window_m(m)
7926
7927           t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) *       &
7928                           surf_usm_h%tt_surface_green_m(m)
7929!
7930!--        Store surface temperature on pt_surface. Further, in case humidity is used
7931!--        store also vpt_surface, which is, due to the lack of moisture on roofs simply
7932!--        assumed to be the surface temperature.
7933           surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(ind_veg_wall,m) * t_surf_wall_h_p(m)   &
7934                               + surf_usm_h%frac(ind_wat_win,m) * t_surf_window_h_p(m)         &
7935                               + surf_usm_h%frac(ind_pav_green,m) * t_surf_green_h_p(m) )      &
7936                               / exner(k)
7937                               
7938           IF ( humidity )  surf_usm_h%vpt_surface(m) =                        &
7939                                                   surf_usm_h%pt_surface(m)
7940!
7941!--        calculate true tendency
7942           stend_wall = ( t_surf_wall_h_p(m) - t_surf_wall_h(m) - dt_3d * tsc(3) *              &
7943                     surf_usm_h%tt_surface_wall_m(m)) / ( dt_3d  * tsc(2) )
7944           stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) *        &
7945                     surf_usm_h%tt_surface_window_m(m)) / ( dt_3d  * tsc(2) )
7946           stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) *           &
7947                     surf_usm_h%tt_surface_green_m(m)) / ( dt_3d  * tsc(2) )
7948!
7949!--        calculate t_surf tendencies for the next Runge-Kutta step
7950           IF ( timestep_scheme(1:5) == 'runge' )  THEN
7951              IF ( intermediate_timestep_count == 1 )  THEN
7952                 surf_usm_h%tt_surface_wall_m(m) = stend_wall
7953                 surf_usm_h%tt_surface_window_m(m) = stend_window
7954                 surf_usm_h%tt_surface_green_m(m) = stend_green
7955              ELSEIF ( intermediate_timestep_count <                          &
7956                        intermediate_timestep_count_max )  THEN
7957                 surf_usm_h%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +       &
7958                                     5.3125_wp * surf_usm_h%tt_surface_wall_m(m)
7959                 surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window +   &
7960                                     5.3125_wp * surf_usm_h%tt_surface_window_m(m)
7961                 surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green +     &
7962                                     5.3125_wp * surf_usm_h%tt_surface_green_m(m)
7963              ENDIF
7964           ENDIF
7965!
7966!--        in case of fast changes in the skin temperature, it is required to
7967!--        update the radiative fluxes in order to keep the solution stable
7968           IF ( ( ( ABS( t_surf_wall_h_p(m)   - t_surf_wall_h(m) )   > 1.0_wp )   .OR. &
7969                (   ABS( t_surf_green_h_p(m)  - t_surf_green_h(m) )  > 1.0_wp )   .OR. &
7970                (   ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) )      &
7971                   .AND.  unscheduled_radiation_calls  )  THEN
7972              force_radiation_call_l = .TRUE.
7973           ENDIF
7974!
7975!--        calculate fluxes
7976!--        rad_net_l is never used!
7977           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) +                           &
7978                                     surf_usm_h%frac(ind_veg_wall,m) *                   &
7979                                     sigma_sb * surf_usm_h%emissivity(ind_veg_wall,m) *  &
7980                                     ( t_surf_wall_h_p(m)**4 - t_surf_wall_h(m)**4 )     &
7981                                    + surf_usm_h%frac(ind_wat_win,m) *                   &
7982                                     sigma_sb * surf_usm_h%emissivity(ind_wat_win,m) *   &
7983                                     ( t_surf_window_h_p(m)**4 - t_surf_window_h(m)**4 ) &
7984                                    + surf_usm_h%frac(ind_pav_green,m) *                 &
7985                                     sigma_sb * surf_usm_h%emissivity(ind_pav_green,m) * &
7986                                     ( t_surf_green_h_p(m)**4 - t_surf_green_h(m)**4 )
7987
7988           surf_usm_h%wghf_eb(m)   = lambda_surface *                                    &
7989                                      ( t_surf_wall_h_p(m) - t_wall_h(nzb_wall,m) )
7990           surf_usm_h%wghf_eb_green(m)  = lambda_surface_green *                         &
7991                                          ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
7992           surf_usm_h%wghf_eb_window(m) = lambda_surface_window *                        &
7993                                           ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
7994
7995!
7996!--        ground/wall/roof surface heat flux
7997           surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_wall_h_p(m) / exner(k) ) *          &
7998                                       surf_usm_h%frac(ind_veg_wall,m)         &
7999                                     - f_shf_window  * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exner(k) ) * &
8000                                       surf_usm_h%frac(ind_wat_win,m)          &
8001                                     - f_shf_green  * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exner(k) ) *   &
8002                                       surf_usm_h%frac(ind_pav_green,m)
8003!           
8004!--        store kinematic surface heat fluxes for utilization in other processes
8005!--        diffusion_s, surface_layer_fluxes,...
8006           surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p
8007!
8008!--        If the indoor model is applied, further add waste heat from buildings to the
8009!--        kinematic flux.
8010           IF ( indoor_model )  THEN
8011              surf_usm_h%shf(m) = surf_usm_h%shf(m) + surf_usm_h%waste_heat(m) / c_p
8012           ENDIF
8013     
8014
8015           IF (surf_usm_h%frac(ind_pav_green,m) > 0.0_wp) THEN
8016
8017              IF ( humidity )  THEN
8018                 surf_usm_h%qsws_eb(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt                  &
8019                                 * t_surf_green_h(m) - dq_s_dt *               &
8020                                   t_surf_green_h_p(m) )
8021       
8022                 surf_usm_h%qsws(m) = surf_usm_h%qsws_eb(m) / rho_lv
8023       
8024                 surf_usm_h%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s                      &
8025                                     + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8026                                     * t_surf_green_h_p(m) )
8027       
8028                 surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s                      &
8029                                     + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8030                                     * t_surf_green_h_p(m) )
8031              ENDIF
8032 
8033!
8034!--           Calculate the true surface resistance
8035              IF ( .NOT.  humidity )  THEN
8036                 surf_usm_h%r_s(m) = 1.0E10_wp
8037              ELSE
8038                 surf_usm_h%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt                       &
8039                                 *  t_surf_green_h(m) - dq_s_dt *              &
8040                                   t_surf_green_h_p(m) ) /                     &
8041                                   (surf_usm_h%qsws(m) + 1.0E-20)  - surf_usm_h%r_a_green(m)
8042              ENDIF
8043 
8044!
8045!--           Calculate change in liquid water reservoir due to dew fall or
8046!--           evaporation of liquid water
8047              IF ( humidity )  THEN
8048!
8049!--              If precipitation is activated, add rain water to qsws_liq
8050!--              and qsws_soil according the the vegetation coverage.
8051!--              precipitation_rate is given in mm.
8052                 IF ( precipitation )  THEN
8053
8054!
8055!--                 Add precipitation to liquid water reservoir, if possible.
8056!--                 Otherwise, add the water to soil. In case of
8057!--                 pavements, the exceeding water amount is implicitely removed
8058!--                 as runoff as qsws_soil is then not used in the soil model
8059                    IF ( m_liq_usm_h%var_usm_1d(m) /= m_liq_max )  THEN
8060                       surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m)                &
8061                                        + surf_usm_h%frac(ind_pav_green,m) * prr(k+k_off,j+j_off,i+i_off)&
8062                                        * hyrho(k+k_off)                              &
8063                                        * 0.001_wp * rho_l * l_v
8064                   ENDIF
8065
8066                 ENDIF
8067
8068!
8069!--              If the air is saturated, check the reservoir water level
8070                 IF ( surf_usm_h%qsws(m) < 0.0_wp )  THEN
8071!
8072!--                 Check if reservoir is full (avoid values > m_liq_max)
8073!--                 In that case, qsws_liq goes to qsws_soil. In this
8074!--                 case qsws_veg is zero anyway (because c_liq = 1),       
8075!--                 so that tend is zero and no further check is needed
8076                    IF ( m_liq_usm_h%var_usm_1d(m) == m_liq_max )  THEN
8077!                      surf_usm_h%qsws_soil(m) = surf_usm_h%qsws_soil(m) + surf_usm_h%qsws_liq(m)
8078                       surf_usm_h%qsws_liq(m)  = 0.0_wp
8079                    ENDIF
8080
8081!
8082!--                 In case qsws_veg becomes negative (unphysical behavior),
8083!--                 let the water enter the liquid water reservoir as dew on the
8084!--                 plant
8085                    IF ( surf_usm_h%qsws_veg(m) < 0.0_wp )  THEN
8086                       surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
8087                       surf_usm_h%qsws_veg(m) = 0.0_wp
8088                    ENDIF
8089                 ENDIF                   
8090 
8091                 surf_usm_h%qsws(m) = surf_usm_h%qsws(m) / l_v
8092       
8093                 tend = - surf_usm_h%qsws_liq(m) * drho_l_lv
8094                 m_liq_usm_h_p%var_usm_1d(m) = m_liq_usm_h%var_usm_1d(m) + dt_3d *    &
8095                                               ( tsc(2) * tend +                      &
8096                                                 tsc(3) * tm_liq_usm_h_m%var_usm_1d(m) )
8097!
8098!--             Check if reservoir is overfull -> reduce to maximum
8099!--             (conservation of water is violated here)
8100                 m_liq_usm_h_p%var_usm_1d(m) = MIN( m_liq_usm_h_p%var_usm_1d(m),m_liq_max )
8101 
8102!
8103!--             Check if reservoir is empty (avoid values < 0.0)
8104!--             (conservation of water is violated here)
8105                 m_liq_usm_h_p%var_usm_1d(m) = MAX( m_liq_usm_h_p%var_usm_1d(m), 0.0_wp )
8106!
8107!--             Calculate m_liq tendencies for the next Runge-Kutta step
8108                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
8109                    IF ( intermediate_timestep_count == 1 )  THEN
8110                       tm_liq_usm_h_m%var_usm_1d(m) = tend
8111                    ELSEIF ( intermediate_timestep_count <                            &
8112                             intermediate_timestep_count_max )  THEN
8113                       tm_liq_usm_h_m%var_usm_1d(m) = -9.5625_wp * tend +             &
8114                                                     5.3125_wp * tm_liq_usm_h_m%var_usm_1d(m)
8115                    ENDIF
8116                 ENDIF
8117 
8118              ENDIF
8119           ELSE
8120              surf_usm_h%r_s(m) = 1.0E10_wp
8121           ENDIF
8122 
8123       ENDDO
8124!
8125!--    Now, treat vertical surface elements
8126       !$OMP DO SCHEDULE (STATIC)
8127       DO  l = 0, 3
8128           DO  m = 1, surf_usm_v(l)%ns
8129!
8130!--          Get indices of respective grid point
8131              i = surf_usm_v(l)%i(m)
8132              j = surf_usm_v(l)%j(m)
8133              k = surf_usm_v(l)%k(m)
8134 
8135!
8136!--          TODO - how to calculate lambda_surface for horizontal (??? do you mean verical ???) surfaces
8137!--          (lambda_surface is set according to stratification in land surface model).
8138!--          Please note, for vertical surfaces no ol is defined, since
8139!--          stratification is not considered in this case.
8140              lambda_surface = surf_usm_v(l)%lambda_surf(m)
8141              lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
8142              lambda_surface_green = surf_usm_v(l)%lambda_surf_green(m)
8143 
8144!            pt1  = pt(k,j,i)
8145              IF ( humidity )  THEN
8146                 qv1 = q(k,j,i)
8147              ELSE
8148                 qv1 = 0.0_wp
8149              ENDIF
8150!
8151!--          calculate rho * c_p coefficient at wall layer
8152              rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) )
8153             
8154              IF (surf_usm_v(l)%frac(1,m) > 0.0_wp )  THEN
8155!
8156!--            Calculate frequently used parameters
8157                 rho_lv    = rho_cp / c_p * l_v
8158                 drho_l_lv = 1.0_wp / (rho_l * l_v)
8159              ENDIF
8160 
8161!--          Calculation of r_a for vertical surfaces
8162!--
8163!--          heat transfer coefficient for forced convection along vertical walls
8164!--          follows formulation in TUF3d model (Krayenhoff & Voogt, 2006)
8165!--           
8166!--          H = httc (Tsfc - Tair)
8167!--          httc = rw * (11.8 + 4.2 * Ueff) - 4.0
8168!--           
8169!--                rw: wall patch roughness relative to 1.0 for concrete
8170!--                Ueff: effective wind speed
8171!--                - 4.0 is a reduction of Rowley et al (1930) formulation based on
8172!--                Cole and Sturrock (1977)
8173!--           
8174!--                Ucan: Canyon wind speed
8175!--                wstar: convective velocity
8176!--                Qs: surface heat flux
8177!--                zH: height of the convective layer
8178!--                wstar = (g/Tcan*Qs*zH)**(1./3.)
8179!--          Effective velocity components must always
8180!--          be defined at scalar grid point. The wall normal component is
8181!--          obtained by simple linear interpolation. ( An alternative would
8182!--          be an logarithmic interpolation. )
8183!--          Parameter roughness_concrete (default value = 0.001) is used
8184!--          to calculation of roughness relative to concrete
8185              surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) /           &
8186                         roughness_concrete * ( 11.8_wp + 4.2_wp *              &
8187                         SQRT( MAX( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 + &
8188                                    ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 + &
8189                                    ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2,  &
8190                               0.01_wp ) )                                      &
8191                            )  - 4.0_wp  ) 
8192!
8193!--          Limit aerodynamic resistance
8194              IF ( surf_usm_v(l)%r_a(m) < 1.0_wp )  surf_usm_v(l)%r_a(m) = 1.0_wp   
8195             
8196                           
8197              f_shf         = rho_cp / surf_usm_v(l)%r_a(m)
8198              f_shf_window  = rho_cp / surf_usm_v(l)%r_a(m)
8199              f_shf_green   = rho_cp / surf_usm_v(l)%r_a(m)
8200 
8201
8202              IF ( surf_usm_v(l)%frac(1,m) > 0.0_wp ) THEN
8203!
8204!--             Adapted from LSM:
8205!--             Second step: calculate canopy resistance r_canopy
8206!--             f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
8207!--             f1: correction for incoming shortwave radiation (stomata close at
8208!--             night)
8209                 f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_v(l)%rad_sw_in(m) + 0.05_wp ) / &
8210                                  (0.81_wp * (0.004_wp * surf_usm_v(l)%rad_sw_in(m)      &
8211                                   + 1.0_wp)) )
8212!
8213!--             f2: correction for soil moisture availability to plants (the
8214!--             integrated soil moisture must thus be considered here)
8215!--             f2 = 0 for very dry soils
8216 
8217                 f2=1.0_wp
8218 
8219!
8220!--              Calculate water vapour pressure at saturation
8221                 e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * (  t_surf_green_v_p(l)%t(m) &
8222                               - 273.16_wp ) / (  t_surf_green_v_p(l)%t(m) - 35.86_wp ) )
8223!
8224!--              f3: correction for vapour pressure deficit
8225                 IF ( surf_usm_v(l)%g_d(m) /= 0.0_wp )  THEN
8226!
8227!--                 Calculate vapour pressure
8228                    e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
8229                    f3 = EXP ( - surf_usm_v(l)%g_d(m) * (e_s - e) )
8230                 ELSE
8231                    f3 = 1.0_wp
8232                 ENDIF
8233!
8234!--              Calculate canopy resistance. In case that c_veg is 0 (bare soils),
8235!--              this calculation is obsolete, as r_canopy is not used below.
8236!--              To do: check for very dry soil -> r_canopy goes to infinity
8237                 surf_usm_v(l)%r_canopy(m) = surf_usm_v(l)%r_canopy_min(m) /                  &
8238                                        ( surf_usm_v(l)%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
8239                               
8240!
8241!--              Calculate saturation specific humidity
8242                 q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8243!
8244!--              In case of dewfall, set evapotranspiration to zero
8245!--              All super-saturated water is then removed from the air
8246                 IF ( humidity  .AND.  q_s <= qv1 )  THEN
8247                    surf_usm_v(l)%r_canopy(m) = 0.0_wp
8248                 ENDIF
8249 
8250!
8251!--              Calculate coefficients for the total evapotranspiration
8252!--              In case of water surface, set vegetation and soil fluxes to zero.
8253!--              For pavements, only evaporation of liquid water is possible.
8254                 f_qsws_veg  = rho_lv *                                &
8255                                   ( 1.0_wp        - 0.0_wp ) / & !surf_usm_h%c_liq(m)    ) /   &
8256                                   ( surf_usm_v(l)%r_a(m) + surf_usm_v(l)%r_canopy(m) )
8257!                f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m)   /             &
8258!                              surf_usm_h%r_a_green(m)
8259         
8260                 f_qsws = f_qsws_veg! + f_qsws_liq
8261!
8262!--              Calculate derivative of q_s for Taylor series expansion
8263                 e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_v_p(l)%t(m) - 35.86_wp) -   &
8264                                  17.269_wp*( t_surf_green_v_p(l)%t(m) - 273.16_wp)      &
8265                                 / ( t_surf_green_v_p(l)%t(m) - 35.86_wp)**2 )
8266         
8267                 dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
8268              ENDIF
8269
8270!
8271!--           add LW up so that it can be removed in prognostic equation
8272              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m)  -        &
8273                                           surf_usm_v(l)%rad_sw_out(m) +        &
8274                                           surf_usm_v(l)%rad_lw_in(m)  -        &
8275                                           surf_usm_v(l)%rad_lw_out(m)
8276!
8277!--           numerator of the prognostic equation
8278              coef_1 = surf_usm_v(l)%rad_net_l(m) +                             & ! coef +1 corresponds to -lwout
8279                                                                                  ! included in calculation of radnet_l
8280              ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_veg_wall,m) *  &
8281                                      sigma_sb *  t_surf_wall_v(l)%t(m) ** 4 +  & 
8282                                      f_shf * surf_usm_v(l)%pt1(m) +            &
8283                                      lambda_surface * t_wall_v(l)%t(nzb_wall,m)
8284              IF ( ( .NOT. spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
8285                 coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                   & ! coef +1 corresponds to -lwout
8286                                                                                  ! included in calculation of radnet_l
8287                ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_wat_win,m) * &
8288                                      sigma_sb * t_surf_window_v(l)%t(m) ** 4 + & 
8289                                      f_shf * surf_usm_v(l)%pt1(m) +            &
8290                                      lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
8291              ENDIF
8292              IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
8293                 coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                      & ! coef +1 corresponds to -lwout
8294                                                                                    ! included in calculation of radnet_l
8295                 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *  &
8296                                      t_surf_green_v(l)%t(m) ** 4 +               & 
8297                                      f_shf * surf_usm_v(l)%pt1(m) +     f_qsws * ( qv1 - q_s  &
8298                                           + dq_s_dt * t_surf_green_v(l)%t(m) ) +              &
8299                                      lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8300              ELSE
8301                coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                       & ! coef +1 corresponds to -lwout included
8302                                                                                    ! in calculation of radnet_l
8303                ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *  &
8304                                      t_surf_green_v(l)%t(m) ** 4 +               & 
8305                                      f_shf * surf_usm_v(l)%pt1(m) +              &
8306                                      lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8307              ENDIF
8308                                     
8309!
8310!--           denominator of the prognostic equation
8311              coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_veg_wall,m) * sigma_sb *   &
8312                                 t_surf_wall_v(l)%t(m) ** 3                             &
8313                               + lambda_surface + f_shf / exner(k) 
8314              IF ( ( .NOT. spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN             
8315                 coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_wat_win,m) * sigma_sb *       &
8316                                   t_surf_window_v(l)%t(m) ** 3                         &
8317                                 + lambda_surface_window + f_shf / exner(k)
8318              ENDIF
8319              IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
8320                  coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *     &
8321                                   t_surf_green_v(l)%t(m) ** 3  + f_qsws * dq_s_dt      &
8322                                 + lambda_surface_green + f_shf / exner(k)
8323              ELSE
8324                 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *      &
8325                                   t_surf_green_v(l)%t(m) ** 3                          &
8326                                 + lambda_surface_green + f_shf / exner(k)
8327              ENDIF
8328!
8329!--           implicit solution when the surface layer has no heat capacity,
8330!--           otherwise use RK3 scheme.
8331              t_surf_wall_v_p(l)%t(m) = ( coef_1 * dt_3d * tsc(2) +                 &
8332                             surf_usm_v(l)%c_surface(m) * t_surf_wall_v(l)%t(m) ) / & 
8333                             ( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
8334              IF ( ( .NOT. spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
8335                 t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) +                 &
8336                                surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / & 
8337                              ( surf_usm_v(l)%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) ) 
8338              ENDIF
8339              t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) +                 &
8340                             surf_usm_v(l)%c_surface_green(m) * t_surf_green_v(l)%t(m) ) / & 
8341                           ( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
8342!
8343!--           add RK3 term
8344              t_surf_wall_v_p(l)%t(m) = t_surf_wall_v_p(l)%t(m) + dt_3d * tsc(3) *         &
8345                                surf_usm_v(l)%tt_surface_wall_m(m)
8346              t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) *     &
8347                                surf_usm_v(l)%tt_surface_window_m(m)
8348              t_surf_green_v_p(l)%t(m) = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) *       &
8349                                 surf_usm_v(l)%tt_surface_green_m(m)
8350!
8351!--           Store surface temperature. Further, in case humidity is used
8352!--           store also vpt_surface, which is, due to the lack of moisture on roofs simply
8353!--           assumed to be the surface temperature.     
8354              surf_usm_v(l)%pt_surface(m) =  ( surf_usm_v(l)%frac(ind_veg_wall,m) * t_surf_wall_v_p(l)%t(m)  &
8355                                      + surf_usm_v(l)%frac(ind_wat_win,m) * t_surf_window_v_p(l)%t(m)        &
8356                                      + surf_usm_v(l)%frac(ind_pav_green,m) * t_surf_green_v_p(l)%t(m) )     &
8357                                      / exner(k)
8358                                       
8359              IF ( humidity )  surf_usm_v(l)%vpt_surface(m) =                  &
8360                                                     surf_usm_v(l)%pt_surface(m)
8361!
8362!--           calculate true tendency
8363              stend_wall = ( t_surf_wall_v_p(l)%t(m) - t_surf_wall_v(l)%t(m) - dt_3d * tsc(3) *      &
8364                        surf_usm_v(l)%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
8365              stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) *&
8366                        surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
8367              stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *   &
8368                        surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
8369
8370!
8371!--           calculate t_surf_* tendencies for the next Runge-Kutta step
8372              IF ( timestep_scheme(1:5) == 'runge' )  THEN
8373                 IF ( intermediate_timestep_count == 1 )  THEN
8374                    surf_usm_v(l)%tt_surface_wall_m(m) = stend_wall
8375                    surf_usm_v(l)%tt_surface_window_m(m) = stend_window
8376                    surf_usm_v(l)%tt_surface_green_m(m) = stend_green
8377                 ELSEIF ( intermediate_timestep_count <                                 &
8378                          intermediate_timestep_count_max )  THEN
8379                    surf_usm_v(l)%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +      &
8380                                     5.3125_wp * surf_usm_v(l)%tt_surface_wall_m(m)
8381                    surf_usm_v(l)%tt_surface_green_m(m) = -9.5625_wp * stend_green +    &
8382                                     5.3125_wp * surf_usm_v(l)%tt_surface_green_m(m)
8383                    surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window +  &
8384                                     5.3125_wp * surf_usm_v(l)%tt_surface_window_m(m)
8385                 ENDIF
8386              ENDIF
8387
8388!
8389!--           in case of fast changes in the skin temperature, it is required to
8390!--           update the radiative fluxes in order to keep the solution stable
8391 
8392              IF ( ( ( ABS( t_surf_wall_v_p(l)%t(m)   - t_surf_wall_v(l)%t(m) )   > 1.0_wp ) .OR. &
8393                   (   ABS( t_surf_green_v_p(l)%t(m)  - t_surf_green_v(l)%t(m) )  > 1.0_wp ) .OR. &
8394                   (   ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) )    &
8395                      .AND.  unscheduled_radiation_calls )  THEN
8396                 force_radiation_call_l = .TRUE.
8397              ENDIF
8398
8399!
8400!--           calculate fluxes
8401!--           prognostic rad_net_l is used just for output!           
8402              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(ind_veg_wall,m) *                      &
8403                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8404                                           3.0_wp * sigma_sb *                                       &
8405                                           t_surf_wall_v(l)%t(m)**4 - 4.0_wp * sigma_sb *            &
8406                                           t_surf_wall_v(l)%t(m)**3 * t_surf_wall_v_p(l)%t(m) )      &
8407                                         + surf_usm_v(l)%frac(ind_wat_win,m) *                       &
8408                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8409                                           3.0_wp * sigma_sb *                                       &
8410                                           t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb *          &
8411                                           t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) )  &
8412                                         + surf_usm_v(l)%frac(ind_pav_green,m) *                     &
8413                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8414                                           3.0_wp * sigma_sb *                                       &
8415                                           t_surf_green_v(l)%t(m)**4 - 4.0_wp * sigma_sb *           &
8416                                           t_surf_green_v(l)%t(m)**3 * t_surf_green_v_p(l)%t(m) )
8417
8418              surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window * &
8419                                                ( t_surf_window_v_p(l)%t(m) - t_window_v(l)%t(nzb_wall,m) )
8420              surf_usm_v(l)%wghf_eb(m)   = lambda_surface *             &
8421                                                ( t_surf_wall_v_p(l)%t(m) - t_wall_v(l)%t(nzb_wall,m) )
8422              surf_usm_v(l)%wghf_eb_green(m)  = lambda_surface_green *  &
8423                                                ( t_surf_green_v_p(l)%t(m) - t_green_v(l)%t(nzb_wall,m) )
8424
8425!
8426!--           ground/wall/roof surface heat flux
8427              surf_usm_v(l)%wshf_eb(m)   =                                     &
8428                 - f_shf  * ( surf_usm_v(l)%pt1(m) -                           &
8429                 t_surf_wall_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_veg_wall,m)       &
8430                 - f_shf_window  * ( surf_usm_v(l)%pt1(m) -                    &
8431                 t_surf_window_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_wat_win,m)&
8432                 - f_shf_green  * ( surf_usm_v(l)%pt1(m) -                     &
8433                 t_surf_green_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_pav_green,m)
8434
8435!           
8436!--           store kinematic surface heat fluxes for utilization in other processes
8437!--           diffusion_s, surface_layer_fluxes,...
8438              surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / c_p
8439!
8440!--           If the indoor model is applied, further add waste heat from buildings to the
8441!--           kinematic flux.
8442              IF ( indoor_model )  THEN
8443                 surf_usm_v(l)%shf(m) = surf_usm_v(l)%shf(m) +                       &
8444                                        surf_usm_v(l)%waste_heat(m) / c_p
8445              ENDIF             
8446
8447              IF ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) THEN
8448 
8449
8450                 IF ( humidity )  THEN
8451                    surf_usm_v(l)%qsws_eb(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt       &
8452                                    * t_surf_green_v(l)%t(m) - dq_s_dt *               &
8453                                      t_surf_green_v_p(l)%t(m) )
8454         
8455                    surf_usm_v(l)%qsws(m) = surf_usm_v(l)%qsws_eb(m) / rho_lv
8456         
8457                    surf_usm_v(l)%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s           &
8458                                        + dq_s_dt * t_surf_green_v(l)%t(m) - dq_s_dt   &
8459                                        * t_surf_green_v_p(l)%t(m) )
8460         
8461!                    surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s         &
8462!                                        + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8463!                                        * t_surf_green_h_p(m) )
8464                 ENDIF
8465 
8466!
8467!--              Calculate the true surface resistance
8468                 IF ( .NOT.  humidity )  THEN
8469                    surf_usm_v(l)%r_s(m) = 1.0E10_wp
8470                 ELSE
8471                    surf_usm_v(l)%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt             &
8472                                    *  t_surf_green_v(l)%t(m) - dq_s_dt *               &
8473                                      t_surf_green_v_p(l)%t(m) ) /                      &
8474                                      (surf_usm_v(l)%qsws(m) + 1.0E-20)  - surf_usm_v(l)%r_a(m)
8475                 ENDIF
8476         
8477!
8478!--              Calculate change in liquid water reservoir due to dew fall or
8479!--              evaporation of liquid water
8480                 IF ( humidity )  THEN
8481!
8482!--                 If the air is saturated, check the reservoir water level
8483                    IF ( surf_usm_v(l)%qsws(m) < 0.0_wp )  THEN
8484       
8485!
8486!--                    In case qsws_veg becomes negative (unphysical behavior),
8487!--                    let the water enter the liquid water reservoir as dew on the
8488!--                    plant
8489                       IF ( surf_usm_v(l)%qsws_veg(m) < 0.0_wp )  THEN
8490          !                 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
8491                          surf_usm_v(l)%qsws_veg(m) = 0.0_wp
8492                       ENDIF
8493                    ENDIF
8494                 
8495                 ENDIF
8496              ELSE
8497                 surf_usm_v(l)%r_s(m) = 1.0E10_wp
8498              ENDIF
8499
8500           ENDDO
8501 
8502       ENDDO
8503       !$OMP END PARALLEL
8504
8505!
8506!--     Add-up anthropogenic heat, for now only at upward-facing surfaces
8507         IF ( usm_anthropogenic_heat  .AND.  &
8508              intermediate_timestep_count == intermediate_timestep_count_max )  THEN
8509!
8510!--        application of the additional anthropogenic heat sources
8511!--        we considere the traffic for now so all heat is absorbed
8512!--        to the first layer, generalization would be worth.
8513!--        calculation of actual profile coefficient
8514!--        ??? check time_since_reference_point ???
8515            dtime = mod(simulated_time + time_utc_init, 24.0_wp*3600.0_wp)
8516            dhour = INT(dtime/3600.0_wp)
8517
8518!--         TO_DO: activate, if testcase is available
8519!--         !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
8520!--         it may also improve performance to move get_topography_top_index_ji before the k-loop
8521            DO i = nxl, nxr
8522               DO j = nys, nyn
8523                  DO k = nz_urban_b, min(nz_urban_t,naheatlayers)
8524                     IF ( k > get_topography_top_index_ji( j, i, 's' ) ) THEN
8525!
8526!--                    increase of pt in box i,j,k in time dt_3d
8527!--                    given to anthropogenic heat aheat*acoef (W*m-2)
8528!--                    linear interpolation of coeficient
8529                        acoef = (REAL(dhour+1,wp)-dtime/3600.0_wp)*aheatprof(k,dhour) + &
8530                                (dtime/3600.0_wp-REAL(dhour,wp))*aheatprof(k,dhour+1)
8531                        IF ( aheat(k,j,i) > 0.0_wp )  THEN
8532!
8533!--                       calculate rho * c_p coefficient at layer k
8534                           rho_cp  = c_p * hyp(k) / ( r_d * pt(k+1,j,i) * exner(k) )
8535                           pt(k,j,i) = pt(k,j,i) + aheat(k,j,i)*acoef*dt_3d/(exner(k)*rho_cp*dz(1))
8536                        ENDIF
8537                     ENDIF
8538                  ENDDO
8539               ENDDO
8540            ENDDO
8541 
8542         ENDIF
8543!
8544!--     pt and shf are defined on nxlg:nxrg,nysg:nyng
8545!--     get the borders from neighbours
8546         CALL exchange_horiz( pt, nbgp )
8547!
8548!--     calculation of force_radiation_call:
8549!--     Make logical OR for all processes.
8550!--     Force radiation call if at least one processor forces it.
8551         IF ( intermediate_timestep_count == intermediate_timestep_count_max-1 )&
8552         THEN
8553#if defined( __parallel )
8554           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
8555           CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,    &
8556                               1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
8557#else
8558           force_radiation_call = force_radiation_call_l
8559#endif
8560           force_radiation_call_l = .FALSE.
8561         ENDIF
8562 
8563! !
8564! !-- Calculate surface specific humidity
8565!     IF ( humidity )  THEN
8566!        CALL calc_q_surface_usm
8567!     ENDIF
8568 
8569 
8570!     CONTAINS
8571! !------------------------------------------------------------------------------!
8572! ! Description:
8573! ! ------------
8574! !> Calculation of specific humidity of the skin layer (surface). It is assumend
8575! !> that the skin is always saturated.
8576! !------------------------------------------------------------------------------!
8577!        SUBROUTINE calc_q_surface_usm
8578!
8579!           IMPLICIT NONE
8580!
8581!           REAL(wp) :: resistance    !< aerodynamic and soil resistance term
8582!
8583!           DO  m = 1, surf_usm_h%ns
8584!
8585!              i   = surf_usm_h%i(m)           
8586!              j   = surf_usm_h%j(m)
8587!              k   = surf_usm_h%k(m)
8588!
8589!!
8590!!--          Calculate water vapour pressure at saturation
8591!              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp *                  &
8592!                                     ( t_surf_green_h_p(m) - 273.16_wp ) /  &
8593!                                     ( t_surf_green_h_p(m) - 35.86_wp  )    &
8594!                                          )
8595!
8596!!
8597!!--          Calculate specific humidity at saturation
8598!              q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8599!
8600!!              surf_usm_h%r_a_green(m) = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /  &
8601!!                    ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
8602!!                 
8603!! !--          make sure that the resistance does not drop to zero
8604!!              IF ( ABS(surf_usm_h%r_a_green(m)) < 1.0E-10_wp )  surf_usm_h%r_a_green(m) = 1.0E-10_wp
8605!
8606!              resistance = surf_usm_h%r_a_green(m) / ( surf_usm_h%r_a_green(m) + surf_usm_h%r_s(m) + 1E-5_wp )
8607!
8608!!
8609!!--          Calculate specific humidity at surface
8610!              IF ( bulk_cloud_model )  THEN
8611!                 q(k,j,i) = resistance * q_s +                   &
8612!                                            ( 1.0_wp - resistance ) *              &
8613!                                            ( q(k,j,i) - ql(k,j,i) )
8614!              ELSE
8615!                 q(k,j,i) = resistance * q_s +                   &
8616!                                            ( 1.0_wp - resistance ) *              &
8617!                                              q(k,j,i)
8618!              ENDIF
8619!
8620!!
8621!!--          Update virtual potential temperature
8622!              vpt(k,j,i) = pt(k,j,i) *         &
8623!                         ( 1.0_wp + 0.61_wp * q(k,j,i) )
8624!
8625!           ENDDO
8626!
8627!!
8628!!--       Now, treat vertical surface elements
8629!           DO  l = 0, 3
8630!              DO  m = 1, surf_usm_v(l)%ns
8631!!
8632!!--             Get indices of respective grid point
8633!                 i = surf_usm_v(l)%i(m)
8634!                 j = surf_usm_v(l)%j(m)
8635!                 k = surf_usm_v(l)%k(m)
8636!
8637!!
8638!!--             Calculate water vapour pressure at saturation
8639!                 e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp *                       &
8640!                                        ( t_surf_green_v_p(l)%t(m) - 273.16_wp ) /  &
8641!                                        ( t_surf_green_v_p(l)%t(m) - 35.86_wp  )    &
8642!                                             )
8643!
8644!!
8645!!--             Calculate specific humidity at saturation
8646!                 q_s = 0.622_wp * e_s / ( surface_pressure -e_s )
8647!
8648!!
8649!!--             Calculate specific humidity at surface
8650!                 IF ( bulk_cloud_model )  THEN
8651!                    q(k,j,i) = ( q(k,j,i) - ql(k,j,i) )
8652!                 ELSE
8653!                    q(k,j,i) = q(k,j,i)
8654!                 ENDIF
8655!!
8656!!--             Update virtual potential temperature
8657!                 vpt(k,j,i) = pt(k,j,i) *         &
8658!                            ( 1.0_wp + 0.61_wp * q(k,j,i) )
8659!
8660!              ENDDO
8661!
8662!           ENDDO
8663!
8664!        END SUBROUTINE calc_q_surface_usm
8665
8666        IF ( debug_output )  THEN
8667           WRITE( debug_string, * ) 'usm_surface_energy_balance | spinup: ', spinup
8668           CALL debug_message( debug_string, 'end' )
8669        ENDIF
8670
8671     END SUBROUTINE usm_surface_energy_balance
8672 
8673 
8674!------------------------------------------------------------------------------!
8675! Description:
8676! ------------
8677!> Swapping of timelevels for t_surf and t_wall
8678!> called out from subroutine swap_timelevel
8679!------------------------------------------------------------------------------!
8680     SUBROUTINE usm_swap_timelevel( mod_count )
8681 
8682        IMPLICIT NONE
8683 
8684        INTEGER(iwp), INTENT(IN) ::  mod_count
8685 
8686       
8687        SELECT CASE ( mod_count )
8688 
8689           CASE ( 0 )
8690!
8691!--          Horizontal surfaces
8692              t_surf_wall_h    => t_surf_wall_h_1;   t_surf_wall_h_p    => t_surf_wall_h_2
8693              t_wall_h         => t_wall_h_1;        t_wall_h_p         => t_wall_h_2
8694              t_surf_window_h  => t_surf_window_h_1; t_surf_window_h_p  => t_surf_window_h_2
8695              t_window_h       => t_window_h_1;      t_window_h_p       => t_window_h_2
8696              t_surf_green_h   => t_surf_green_h_1;  t_surf_green_h_p   => t_surf_green_h_2
8697              t_green_h        => t_green_h_1;       t_green_h_p        => t_green_h_2
8698!
8699!--          Vertical surfaces
8700              t_surf_wall_v    => t_surf_wall_v_1;   t_surf_wall_v_p    => t_surf_wall_v_2
8701              t_wall_v         => t_wall_v_1;        t_wall_v_p         => t_wall_v_2
8702              t_surf_window_v  => t_surf_window_v_1; t_surf_window_v_p  => t_surf_window_v_2
8703              t_window_v       => t_window_v_1;      t_window_v_p       => t_window_v_2
8704              t_surf_green_v   => t_surf_green_v_1;  t_surf_green_v_p   => t_surf_green_v_2
8705              t_green_v        => t_green_v_1;       t_green_v_p        => t_green_v_2
8706           CASE ( 1 )
8707!
8708!--          Horizontal surfaces
8709              t_surf_wall_h    => t_surf_wall_h_2;   t_surf_wall_h_p    => t_surf_wall_h_1
8710              t_wall_h         => t_wall_h_2;        t_wall_h_p         => t_wall_h_1
8711              t_surf_window_h  => t_surf_window_h_2; t_surf_window_h_p  => t_surf_window_h_1
8712              t_window_h       => t_window_h_2;      t_window_h_p       => t_window_h_1
8713              t_surf_green_h   => t_surf_green_h_2;  t_surf_green_h_p   => t_surf_green_h_1
8714              t_green_h        => t_green_h_2;       t_green_h_p        => t_green_h_1
8715!
8716!--          Vertical surfaces
8717              t_surf_wall_v    => t_surf_wall_v_2;   t_surf_wall_v_p    => t_surf_wall_v_1
8718              t_wall_v         => t_wall_v_2;        t_wall_v_p         => t_wall_v_1
8719              t_surf_window_v  => t_surf_window_v_2; t_surf_window_v_p  => t_surf_window_v_1
8720              t_window_v       => t_window_v_2;      t_window_v_p       => t_window_v_1
8721              t_surf_green_v   => t_surf_green_v_2;  t_surf_green_v_p   => t_surf_green_v_1
8722              t_green_v        => t_green_v_2;       t_green_v_p        => t_green_v_1
8723        END SELECT
8724         
8725     END SUBROUTINE usm_swap_timelevel
8726 
8727!------------------------------------------------------------------------------!
8728! Description:
8729! ------------
8730!> Subroutine writes t_surf and t_wall data into restart files
8731!------------------------------------------------------------------------------!
8732     SUBROUTINE usm_wrd_local
8733 
8734     
8735        IMPLICIT NONE
8736       
8737        CHARACTER(LEN=1) ::  dum     !< dummy string to create output-variable name 
8738        INTEGER(iwp)     ::  l       !< index surface type orientation
8739 
8740        CALL wrd_write_string( 'ns_h_on_file_usm' )
8741        WRITE ( 14 )  surf_usm_h%ns
8742 
8743        CALL wrd_write_string( 'ns_v_on_file_usm' )
8744        WRITE ( 14 )  surf_usm_v(0:3)%ns
8745 
8746        CALL wrd_write_string( 'usm_start_index_h' )
8747        WRITE ( 14 )  surf_usm_h%start_index
8748 
8749        CALL wrd_write_string( 'usm_end_index_h' )
8750        WRITE ( 14 )  surf_usm_h%end_index
8751 
8752        CALL wrd_write_string( 't_surf_wall_h' )
8753        WRITE ( 14 )  t_surf_wall_h
8754 
8755        CALL wrd_write_string( 't_surf_window_h' )
8756        WRITE ( 14 )  t_surf_window_h
8757 
8758        CALL wrd_write_string( 't_surf_green_h' )
8759        WRITE ( 14 )  t_surf_green_h
8760!
8761!--     Write restart data which is especially needed for the urban-surface
8762!--     model. In order to do not fill up the restart routines in
8763!--     surface_mod.
8764!--     Output of waste heat from indoor model. Restart data is required in
8765!--     this special case, because the indoor model where waste heat is
8766!--     computed is call each hour (current default), so that waste heat would
8767!--     have zero value until next call of indoor model.
8768        IF ( indoor_model )  THEN
8769           CALL wrd_write_string( 'waste_heat_h' )
8770           WRITE ( 14 )  surf_usm_h%waste_heat
8771        ENDIF   
8772           
8773        DO  l = 0, 3
8774 
8775           CALL wrd_write_string( 'usm_start_index_v' )
8776           WRITE ( 14 )  surf_usm_v(l)%start_index
8777 
8778           CALL wrd_write_string( 'usm_end_index_v' )
8779           WRITE ( 14 )  surf_usm_v(l)%end_index
8780 
8781           WRITE( dum, '(I1)')  l         
8782 
8783           CALL wrd_write_string( 't_surf_wall_v(' // dum // ')' )
8784           WRITE ( 14 )  t_surf_wall_v(l)%t
8785 
8786           CALL wrd_write_string( 't_surf_window_v(' // dum // ')' )
8787           WRITE ( 14 ) t_surf_window_v(l)%t     
8788 
8789           CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
8790           WRITE ( 14 ) t_surf_green_v(l)%t 
8791           
8792           IF ( indoor_model )  THEN
8793              CALL wrd_write_string( 'waste_heat_v(' // dum // ')' )
8794              WRITE ( 14 )  surf_usm_v(l)%waste_heat
8795           ENDIF
8796           
8797        ENDDO
8798 
8799        CALL wrd_write_string( 'usm_start_index_h' )
8800        WRITE ( 14 )  surf_usm_h%start_index
8801 
8802        CALL wrd_write_string( 'usm_end_index_h' )
8803        WRITE ( 14 )  surf_usm_h%end_index
8804 
8805        CALL wrd_write_string( 't_wall_h' )
8806        WRITE ( 14 )  t_wall_h
8807 
8808        CALL wrd_write_string( 't_window_h' )
8809        WRITE ( 14 )  t_window_h
8810 
8811        CALL wrd_write_string( 't_green_h' )
8812        WRITE ( 14 )  t_green_h
8813 
8814        DO  l = 0, 3
8815 
8816           CALL wrd_write_string( 'usm_start_index_v' )
8817           WRITE ( 14 )  surf_usm_v(l)%start_index
8818 
8819           CALL wrd_write_string( 'usm_end_index_v' )
8820           WRITE ( 14 )  surf_usm_v(l)%end_index
8821 
8822           WRITE( dum, '(I1)')  l     
8823 
8824           CALL wrd_write_string( 't_wall_v(' // dum // ')' )
8825           WRITE ( 14 )  t_wall_v(l)%t
8826 
8827           CALL wrd_write_string( 't_window_v(' // dum // ')' )
8828           WRITE ( 14 )  t_window_v(l)%t
8829 
8830           CALL wrd_write_string( 't_green_v(' // dum // ')' )
8831           WRITE ( 14 )  t_green_v(l)%t
8832       
8833        ENDDO
8834       
8835     END SUBROUTINE usm_wrd_local
8836     
8837     
8838!------------------------------------------------------------------------------!
8839! Description:
8840! ------------
8841!> Define building properties
8842!------------------------------------------------------------------------------!
8843     SUBROUTINE usm_define_pars     
8844!
8845!--     Define the building_pars
8846        building_pars(:,1) = (/   &
8847           0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
8848           0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
8849           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
8850           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
8851           1.5_wp,         &  !< parameter 4   - LAI roof
8852           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
8853           2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
8854           1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
8855           1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
8856           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
8857           0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
8858           2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
8859           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
8860           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
8861           0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
8862           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
8863           0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
8864           0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
8865           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
8866           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
8867           4.0_wp,         &  !< parameter 20  - ground floor level height
8868           0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
8869           0.25_wp,        &  !< parameter 22  - window fraction ground floor level
8870           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
8871           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
8872           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
8873           2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
8874           1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
8875           1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
8876           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
8877           0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
8878           2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
8879           0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
8880           0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
8881           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
8882           0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
8883           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
8884           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
8885           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
8886           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
8887           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
8888           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
8889           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
8890           0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
8891           0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
8892           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
8893           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
8894           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
8895           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
8896           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
8897           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
8898           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
8899           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
8900           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
8901           0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
8902           0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
8903           2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
8904           1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
8905           1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
8906           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
8907           0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
8908           2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
8909           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
8910           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
8911           0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
8912           0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
8913           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
8914           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
8915           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
8916           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
8917           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
8918           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
8919           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
8920           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
8921           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
8922           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
8923           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
8924           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
8925           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
8926           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
8927           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
8928           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
8929           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
8930           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
8931           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
8932           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
8933           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
8934           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
8935           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
8936           1.0_wp,         &  !< parameter 89  - wall fraction roof
8937           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
8938           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
8939           0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
8940           0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
8941           2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
8942           1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
8943           1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
8944           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
8945           0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
8946           2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
8947           0.93_wp,        &  !< parameter 100 - wall emissivity roof
8948           27.0_wp,        &  !< parameter 101 - wall albedo roof
8949           0.0_wp,         &  !< parameter 102 - window fraction roof
8950           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
8951           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
8952           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
8953           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
8954           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
8955           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
8956           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
8957           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
8958           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
8959           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
8960           0.91_wp,        &  !< parameter 113 - window emissivity roof
8961           0.75_wp,        &  !< parameter 114 - window transmissivity roof
8962           27.0_wp,        &  !< parameter 115 - window albedo roof
8963           0.86_wp,        &  !< parameter 116 - green emissivity roof
8964           5.0_wp,         &  !< parameter 117 - green albedo roof
8965           0.0_wp,         &  !< parameter 118 - green type roof
8966           0.8_wp,         &  !< parameter 119 - shading factor
8967           0.76_wp,        &  !< parameter 120 - g-value windows
8968           5.0_wp,         &  !< parameter 121 - u-value windows
8969           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
8970           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
8971           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
8972           3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
8973           370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
8974           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
8975           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
8976           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
8977           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
8978           10.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
8979           3.0_wp,         &  !< parameter 132 - storey height
8980           0.2_wp          &  !< parameter 133 - ceiling construction height
8981                            /)
8982                           
8983        building_pars(:,2) = (/   &
8984           0.73_wp,        &  !< parameter 0   - wall fraction above ground floor level
8985           0.27_wp,        &  !< parameter 1   - window fraction above ground floor level
8986           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
8987           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
8988           1.5_wp,         &  !< parameter 4   - LAI roof
8989           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
8990           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
8991           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
8992           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
8993           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
8994           0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
8995           0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
8996           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
8997           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
8998           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
8999           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9000           0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
9001           0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9002           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9003           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9004           4.0_wp,         &  !< parameter 20  - ground floor level height
9005           0.78_wp,        &  !< parameter 21  - wall fraction ground floor level
9006           0.22_wp,        &  !< parameter 22  - window fraction ground floor level
9007           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9008           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9009           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9010           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9011           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9012           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9013           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9014           0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9015           0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9016           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9017           0.11_wp,        &  !< parameter 33  - window emissivity ground floor level
9018           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9019           0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
9020           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9021           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9022           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9023           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9024           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9025           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9026           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9027           0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9028           0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9029           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9030           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9031           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9032           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9033           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9034           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9035           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9036           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9037           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9038           0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9039           0.42_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9040           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9041           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9042           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9043           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9044           0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9045           0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9046           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9047           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9048           0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9049           0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9050           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9051           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9052           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9053           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9054           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9055           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9056           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9057           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9058           0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9059           0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9060           0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9061           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9062           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9063           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9064           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9065           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9066           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9067           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9068           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9069           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9070           0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9071           0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9072           0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9073           1.0_wp,         &  !< parameter 89  - wall fraction roof
9074           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9075           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9076           0.5_wp,         &  !< parameter 92  - 3rd wall layer thickness roof
9077           0.79_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9078           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9079           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9080           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9081           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9082           0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9083           0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9084           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9085           27.0_wp,        &  !< parameter 101 - wall albedo roof
9086           0.0_wp,         &  !< parameter 102 - window fraction roof
9087           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9088           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9089           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9090           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9091           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9092           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9093           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9094           0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9095           0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9096           0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9097           0.87_wp,        &  !< parameter 113 - window emissivity roof
9098           0.7_wp,         &  !< parameter 114 - window transmissivity roof
9099           27.0_wp,        &  !< parameter 115 - window albedo roof
9100           0.86_wp,        &  !< parameter 116 - green emissivity roof
9101           5.0_wp,         &  !< parameter 117 - green albedo roof
9102           0.0_wp,         &  !< parameter 118 - green type roof
9103           0.8_wp,         &  !< parameter 119 - shading factor
9104           0.6_wp,         &  !< parameter 120 - g-value windows
9105           3.0_wp,         &  !< parameter 121 - u-value windows
9106           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9107           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9108           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9109           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9110           165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9111           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9112           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9113           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9114           4.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9115           8.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9116           3.0_wp,         &  !< parameter 132 - storey height
9117           0.2_wp          &  !< parameter 133 - ceiling construction height
9118                            /)
9119                           
9120        building_pars(:,3) = (/   &
9121           0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
9122           0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
9123           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9124           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9125           1.5_wp,         &  !< parameter 4   - LAI roof
9126           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9127           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9128           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9129           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9130           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9131           0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9132           0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9133           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9134           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9135           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9136           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9137           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9138           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9139           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9140           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9141           4.0_wp,         &  !< parameter 20  - ground floor level height
9142           0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
9143           0.25_wp,        &  !< parameter 22  - window fraction ground floor level
9144           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9145           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9146           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9147           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9148           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9149           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9150           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9151           0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9152           0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9153           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9154           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9155           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9156           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9157           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9158           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9159           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9160           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9161           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9162           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9163           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9164           0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9165           0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9166           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9167           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9168           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9169           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9170           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9171           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9172           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9173           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9174           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9175           0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9176           0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9177           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9178           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9179           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9180           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9181           0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9182           0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9183           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9184           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9185           0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9186           0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9187           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9188           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9189           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9190           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9191           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9192           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9193           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9194           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9195           0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9196           0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9197           0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9198           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9199           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9200           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9201           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9202           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9203           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9204           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9205           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9206           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9207           0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9208           0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9209           0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9210           1.0_wp,         &  !< parameter 89  - wall fraction roof
9211           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9212           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9213           0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9214           0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9215           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9216           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9217           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9218           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9219           0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9220           0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9221           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9222           27.0_wp,        &  !< parameter 101 - wall albedo roof
9223           0.0_wp,         &  !< parameter 102 - window fraction roof
9224           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9225           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9226           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9227           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9228           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9229           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9230           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9231           0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9232           0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9233           0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9234           0.8_wp,         &  !< parameter 113 - window emissivity roof
9235           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9236           27.0_wp,        &  !< parameter 115 - window albedo roof
9237           0.86_wp,        &  !< parameter 116 - green emissivity roof
9238           5.0_wp,         &  !< parameter 117 - green albedo roof
9239           0.0_wp,         &  !< parameter 118 - green type roof
9240           0.8_wp,         &  !< parameter 119 - shading factor
9241           0.5_wp,         &  !< parameter 120 - g-value windows
9242           0.6_wp,         &  !< parameter 121 - u-value windows
9243           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9244           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9245           0.8_wp,         &  !< parameter 124 - heat recovery efficiency
9246           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9247           80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9248           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9249           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9250           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9251           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9252           8.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9253           3.0_wp,         &  !< parameter 132 - storey height
9254           0.2_wp          &  !< parameter 133 - ceiling construction height
9255                            /)   
9256                           
9257        building_pars(:,4) = (/   &
9258           0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9259           0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9260           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9261           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9262           1.5_wp,         &  !< parameter 4   - LAI roof
9263           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9264           2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9265           1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9266           1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9267           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9268           0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9269           2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9270           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9271           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9272           0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9273           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9274           0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
9275           0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
9276           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9277           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9278           4.0_wp,         &  !< parameter 20  - ground floor level height
9279           0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9280           0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9281           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9282           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9283           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9284           2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9285           1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9286           1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9287           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9288           0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9289           2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9290           0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
9291           0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
9292           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9293           0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
9294           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9295           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9296           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9297           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9298           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9299           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9300           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9301           0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9302           0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9303           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9304           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9305           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9306           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9307           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9308           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9309           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9310           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9311           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9312           0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9313           0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9314           2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9315           1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9316           1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9317           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9318           0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9319           2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9320           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9321           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9322           0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9323           0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9324           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9325           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9326           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9327           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9328           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9329           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9330           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9331           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9332           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9333           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9334           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9335           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9336           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9337           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9338           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9339           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9340           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9341           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9342           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9343           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9344           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9345           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9346           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9347           1.0_wp,         &  !< parameter 89  - wall fraction roof
9348           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9349           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9350           0.39_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9351           0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9352           2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9353           1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9354           1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9355           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9356           0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9357           2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9358           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9359           27.0_wp,        &  !< parameter 101 - wall albedo roof
9360           0.0_wp,         &  !< parameter 102 - window fraction roof
9361           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9362           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9363           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9364           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9365           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9366           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9367           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9368           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9369           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9370           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9371           0.91_wp,        &  !< parameter 113 - window emissivity roof
9372           0.75_wp,        &  !< parameter 114 - window transmissivity roof
9373           27.0_wp,        &  !< parameter 115 - window albedo roof
9374           0.86_wp,        &  !< parameter 116 - green emissivity roof
9375           5.0_wp,         &  !< parameter 117 - green albedo roof
9376           0.0_wp,         &  !< parameter 118 - green type roof
9377           0.8_wp,         &  !< parameter 119 - shading factor
9378           0.76_wp,        &  !< parameter 120 - g-value windows
9379           5.0_wp,         &  !< parameter 121 - u-value windows
9380           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9381           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9382           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9383           3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9384           370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9385           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9386           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9387           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9388           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9389           10.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9390           3.0_wp,         &  !< parameter 132 - storey height
9391           0.2_wp          &  !< parameter 133 - ceiling construction height
9392                            /)   
9393                           
9394        building_pars(:,5) = (/   &
9395           0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9396           0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9397           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9398           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9399           1.5_wp,         &  !< parameter 4   - LAI roof
9400           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9401           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9402           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9403           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9404           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9405           0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9406           0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9407           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9408           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9409           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9410           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9411           0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
9412           0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9413           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9414           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9415           4.0_wp,         &  !< parameter 20  - ground floor level height
9416           0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9417           0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9418           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9419           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9420           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9421           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9422           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9423           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9424           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9425           0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9426           0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9427           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9428           0.87_wp,        &  !< parameter 33  - window emissivity ground floor level
9429           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9430           0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
9431           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9432           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9433           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9434           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9435           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9436           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9437           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9438           0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9439           0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9440           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9441           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9442           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9443           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9444           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9445           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9446           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9447           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9448           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9449           0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9450           0.43_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9451           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9452           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9453           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9454           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9455           0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9456           0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9457           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9458           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9459           0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9460           0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9461           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9462           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9463           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9464           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9465           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9466           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9467           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9468           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9469           0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9470           0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9471           0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9472           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9473           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9474           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9475           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9476           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9477           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9478           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9479           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9480           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9481           0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9482           0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9483           0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9484           1.0_wp,         &  !< parameter 89  - wall fraction roof
9485           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9486           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9487           0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9488           0.43_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9489           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9490           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9491           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9492           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9493           0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9494           0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9495           0.91_wp,        &  !< parameter 100 - wall emissivity roof
9496           27.0_wp,        &  !< parameter 101 - wall albedo roof
9497           0.0_wp,         &  !< parameter 102 - window fraction roof
9498           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9499           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9500           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9501           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9502           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9503           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9504           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9505           0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9506           0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9507           0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9508           0.87_wp,        &  !< parameter 113 - window emissivity roof
9509           0.7_wp,         &  !< parameter 114 - window transmissivity roof
9510           27.0_wp,        &  !< parameter 115 - window albedo roof
9511           0.86_wp,        &  !< parameter 116 - green emissivity roof
9512           5.0_wp,         &  !< parameter 117 - green albedo roof
9513           0.0_wp,         &  !< parameter 118 - green type roof
9514           0.8_wp,         &  !< parameter 119 - shading factor
9515           0.6_wp,         &  !< parameter 120 - g-value windows
9516           3.0_wp,         &  !< parameter 121 - u-value windows
9517           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9518           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9519           0.65_wp,        &  !< parameter 124 - heat recovery efficiency
9520           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9521           165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9522           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9523           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9524           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9525           7.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9526           20.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9527           3.0_wp,         &  !< parameter 132 - storey height
9528           0.2_wp          &  !< parameter 133 - ceiling construction height
9529                            /)
9530                           
9531        building_pars(:,6) = (/   &
9532           0.425_wp,       &  !< parameter 0   - wall fraction above ground floor level
9533           0.575_wp,       &  !< parameter 1   - window fraction above ground floor level
9534           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9535           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9536           1.5_wp,         &  !< parameter 4   - LAI roof
9537           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9538           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9539           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9540           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9541           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9542           0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9543           0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9544           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9545           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9546           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9547           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9548           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9549           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9550           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9551           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9552           4.0_wp,         &  !< parameter 20  - ground floor level height
9553           0.475_wp,       &  !< parameter 21  - wall fraction ground floor level
9554           0.525_wp,       &  !< parameter 22  - window fraction ground floor level
9555           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9556           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9557           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9558           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9559           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9560           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9561           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9562           0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9563           0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9564           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9565           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9566           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9567           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9568           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9569           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9570           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9571           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9572           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9573           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9574           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9575           0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9576           0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9577           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9578           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9579           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9580           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9581           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9582           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9583           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9584           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9585           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9586           0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9587           0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9588           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9589           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9590           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9591           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9592           0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9593           0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9594           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9595           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9596           0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9597           0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9598           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9599           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9600           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9601           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9602           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9603           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9604           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9605           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9606           0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9607           0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9608           0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9609           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9610           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9611           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9612           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9613           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9614           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9615           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9616           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9617           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9618           0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9619           0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9620           0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9621           1.0_wp,         &  !< parameter 89  - wall fraction roof
9622           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9623           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9624           0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9625           0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9626           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9627           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9628           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9629           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9630           0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9631           0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9632           0.91_wp,        &  !< parameter 100 - wall emissivity roof
9633           27.0_wp,        &  !< parameter 101 - wall albedo roof
9634           0.0_wp,         &  !< parameter 102 - window fraction roof
9635           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9636           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9637           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9638           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9639           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9640           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9641           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9642           0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9643           0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9644           0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9645           0.8_wp,         &  !< parameter 113 - window emissivity roof
9646           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9647           27.0_wp,        &  !< parameter 115 - window albedo roof
9648           0.86_wp,        &  !< parameter 116 - green emissivity roof
9649           5.0_wp,         &  !< parameter 117 - green albedo roof
9650           0.0_wp,         &  !< parameter 118 - green type roof
9651           0.8_wp,         &  !< parameter 119 - shading factor
9652           0.5_wp,         &  !< parameter 120 - g-value windows
9653           0.6_wp,         &  !< parameter 121 - u-value windows
9654           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9655           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9656           0.9_wp,         &  !< parameter 124 - heat recovery efficiency
9657           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9658           80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9659           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9660           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9661           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9662           5.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9663           15.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9664           3.0_wp,         &  !< parameter 132 - storey height
9665           0.2_wp          &  !< parameter 133 - ceiling construction height
9666                            /)
9667                           
9668        building_pars(:,7) = (/   &
9669           1.0_wp,         &  !< parameter 0   - wall fraction above ground floor level
9670           0.0_wp,         &  !< parameter 1   - window fraction above ground floor level
9671           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9672           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9673           1.5_wp,         &  !< parameter 4   - LAI roof
9674           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9675           1950400.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9676           1848000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9677           1848000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9678           0.7_wp,         &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9679           1.0_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9680           1.0_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9681           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9682           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9683           0.9_wp,         &  !< parameter 14  - wall emissivity above ground floor level
9684           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9685           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9686           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9687           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9688           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9689           4.0_wp,         &  !< parameter 20  - ground floor level height
9690           1.0_wp,         &  !< parameter 21  - wall fraction ground floor level
9691           0.0_wp,         &  !< parameter 22  - window fraction ground floor level
9692           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9693           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9694           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9695           1950400.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9696           1848000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9697           1848000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9698           0.7_wp,         &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9699           1.0_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9700           1.0_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9701           0.9_wp,         &  !< parameter 32  - wall emissivity ground floor level
9702           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9703           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9704           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9705           0.01_wp,        &  !< parameter 36  - z0 roughness ground floor level
9706           0.001_wp,       &  !< parameter 37  - z0h/z0q roughness heat/humidity
9707           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9708           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9709           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9710           0.29_wp,        &  !< parameter 41  - 1st wall layer thickness above ground floor level
9711           0.295_wp,       &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9712           0.695_wp,       &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9713           0.985_wp,       &  !< parameter 44  - 4th wall layer thickness above ground floor level
9714           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9715           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9716           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9717           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9718           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9719           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9720           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9721           0.29_wp,        &  !< parameter 52  - 1st wall layer thickness ground plate
9722           0.295_wp,       &  !< parameter 53  - 2nd wall layer thickness ground plate
9723           0.695_wp,       &  !< parameter 54  - 3rd wall layer thickness ground plate
9724           0.985_wp,       &  !< parameter 55  - 4th wall layer thickness ground plate
9725           1950400.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9726           1848000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9727           1848000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9728           0.7_wp,         &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9729           1.0_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9730           1.0_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9731           0.29_wp,        &  !< parameter 62  - 1st wall layer thickness ground floor level
9732           0.295_wp,       &  !< parameter 63  - 2nd wall layer thickness ground floor level
9733           0.695_wp,       &  !< parameter 64  - 3rd wall layer thickness ground floor level
9734           0.985_wp,       &  !< parameter 65  - 4th wall layer thickness ground floor level
9735           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9736           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9737           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9738           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9739           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9740           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9741           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9742           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9743           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9744           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9745           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9746           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9747           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9748           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9749           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9750           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9751           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9752           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9753           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9754           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9755           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9756           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9757           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9758           1.0_wp,         &  !< parameter 89  - wall fraction roof
9759           0.29_wp,        &  !< parameter 90  - 1st wall layer thickness roof
9760           0.295_wp,       &  !< parameter 91  - 2nd wall layer thickness roof
9761           0.695_wp,       &  !< parameter 92  - 3rd wall layer thickness roof
9762           0.985_wp,       &  !< parameter 93  - 4th wall layer thickness roof
9763           1950400.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9764           1848000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9765           1848000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9766           0.7_wp,         &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9767           1.0_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9768           1.0_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9769           0.9_wp,         &  !< parameter 100 - wall emissivity roof
9770           27.0_wp,        &  !< parameter 101 - wall albedo roof
9771           0.0_wp,         &  !< parameter 102 - window fraction roof
9772           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9773           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9774           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9775           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9776           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9777           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9778           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9779           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9780           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9781           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9782           0.8_wp,         &  !< parameter 113 - window emissivity roof
9783           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9784           27.0_wp,        &  !< parameter 115 - window albedo roof
9785           0.86_wp,        &  !< parameter 116 - green emissivity roof
9786           5.0_wp,         &  !< parameter 117 - green albedo roof
9787           0.0_wp,         &  !< parameter 118 - green type roof
9788           0.8_wp,         &  !< parameter 119 - shading factor
9789           100.0_wp,       &  !< parameter 120 - g-value windows
9790           100.0_wp,       &  !< parameter 121 - u-value windows
9791           20.0_wp,        &  !< parameter 122 - basical airflow without occupancy of the room
9792           20.0_wp,        &  !< parameter 123 - additional airflow depend of occupancy of the room
9793           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9794           1.0_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9795           1.0_wp,         &  !< parameter 126 - dynamic parameter innner heatstorage
9796           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9797           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9798           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9799           0.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9800           0.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9801           3.0_wp,         &  !< parameter 132 - storey height
9802           0.2_wp          &  !< parameter 133 - ceiling construction height
9803                        /)
9804                       
9805     END SUBROUTINE usm_define_pars
9806 
9807   
9808  END MODULE urban_surface_mod
Note: See TracBrowser for help on using the repository browser.