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

Last change on this file since 4648 was 4630, checked in by suehring, 4 years ago

Land-surface model: bugfix in level 3 initialization of root-area-density; Avoid double classifiation of vertical walls (at surfaces that are alo covered by buildings); Land/urban surface: bugfix in resistance calculation - avoid potential divisions by zero; init_grid: in case of ASCII topography flag grid points as terrain and building to allow application of land/urban-surface model

  • Property svn:keywords set to Id
File size: 533.4 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 terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 2015-2020 Czech Technical University in Prague
17! Copyright 2015-2020 Institute of Computer Science of the Czech Academy of Sciences, Prague
18! Copyright 1997-2020 Leibniz Universitaet Hannover
19!--------------------------------------------------------------------------------------------------!
20!
21!
22! Current revisions:
23! -----------------
24!
25!
26! Former revisions:
27! -----------------
28! $Id: urban_surface_mod.f90 4630 2020-07-30 14:54:34Z raasch $
29! - Bugfix in resistance calculation - avoid potential divisions by zero
30! - Minor formatting adjustment
31!
32! 4602 2020-07-14 14:49:45Z suehring
33! Add missing initialization of albedo type with values given from static input file
34!
35! 4581 2020-06-29 08:49:58Z suehring
36! Missing initialization in case of cyclic_fill runs
37!
38! 4535 2020-05-15 12:07:23Z raasch
39! bugfix for restart data format query
40!
41! 4517 2020-05-03 14:29:30Z raasch
42! added restart with MPI-IO for reading local arrays
43!
44! 4510 2020-04-29 14:19:18Z raasch
45! Further re-formatting to follow the PALM coding standard
46!
47! 4509 2020-04-26 15:57:55Z raasch
48! File re-formatted to follow the PALM coding standard
49!
50! 4500 2020-04-17 10:12:45Z suehring
51! Allocate array for wall heat flux, which is further used to aggregate tile
52! fractions in the surface output
53!
54! 4495 2020-04-13 20:11:20Z raasch
55! Restart data handling with MPI-IO added
56!
57! 4493 2020-04-10 09:49:43Z pavelkrc
58! J.Resler, 2020/03/19
59! - Remove reading of deprecated input parameters c_surface and lambda_surf
60! - And calculate them from parameters of the outer wall/roof layer
61!
62! 4481 2020-03-31 18:55:54Z maronga
63! Use statement for exchange horiz added
64!
65! 4442 2020-03-04 19:21:13Z suehring
66! Change order of dimension in surface arrays %frac, %emissivity and %albedo to allow for better
67! vectorization in the radiation interactions.
68!
69! 4441 2020-03-04 19:20:35Z suehring
70! Removed wall_flags_static_0 from USE statements as it's not used within the module
71!
72! 4329 2019-12-10 15:46:36Z motisi
73! Renamed wall_flags_0 to wall_flags_static_0
74!
75! 4309 2019-11-26 18:49:59Z suehring
76! - Bugfix, include m_liq into restarts
77! - Remove unused arrays for liquid water and saturation moisture at vertical walls
78!
79! 4305 2019-11-25 11:15:40Z suehring
80! Revision of some indoor-model parameters
81!
82! 4259 2019-10-09 10:05:22Z suehring
83! Instead of terminate the job in case the relative wall fractions do not sum-up to one, give only
84! an informative message and normalize the fractions.
85!
86! 4258 2019-10-07 13:29:08Z suehring
87! - Add checks to ensure that relative fractions of walls, windowns and green surfaces sum-up to one.
88! - Revise message calls dealing with local checks.
89!
90! 4245 2019-09-30 08:40:37Z pavelkrc
91! Initialize explicit per-surface parameters from building_surface_pars
92!
93! 4238 2019-09-25 16:06:01Z suehring
94! Indoor-model parameters for some building types adjusted in order to avoid unrealistically high
95! indoor temperatures (S. Rissmann)
96!
97! 4230 2019-09-11 13:58:14Z suehring
98! Bugfix, initialize canopy resistance. Even if no green fraction is set, r_canopy must be
99! initialized for output purposes.
100!
101! 4227 2019-09-10 18:04:34Z gronemeier
102! Implement new palm_date_time_mod
103!
104! 4214 2019-09-02 15:57:02Z suehring
105! Bugfix, missing initialization and clearing of soil-moisture tendency (J.Resler)
106!
107! 4182 2019-08-22 15:20:23Z scharf
108! Corrected 'Former revisions' section
109!
110! 4168 2019-08-16 13:50:17Z suehring
111! Replace function get_topography_top_index by topo_top_ind
112!
113! 4148 2019-08-08 11:26:00Z suehring
114! - Add anthropogenic heat output factors for heating and cooling to building data base
115! - Move definition of building_pars to usm_init_arrays since it is already required in the indoor
116!   model
117!
118! 4127 2019-07-30 14:47:10Z suehring
119! Do not add anthopogenic energy during wall/soil spin-up (merge from branch resler)
120!
121! 4077 2019-07-09 13:27:11Z gronemeier
122! Set roughness length z0 and z0h/q at ground-floor level to same value as those above ground-floor
123! level
124!
125! 4051 2019-06-24 13:58:30Z suehring
126! Remove work-around for green surface fraction on buildings (do not set it zero)
127!
128! 4050 2019-06-24 13:57:27Z suehring
129! In order to avoid confusion with global control parameter, rename the USM-internal flag spinup
130! into during_spinup.
131!
132! 3987 2019-05-22 09:52:13Z kanani
133! Introduce alternative switch for debug output during timestepping
134!
135! 3943 2019-05-02 09:50:41Z maronga
136! Removed qsws_eb. Bugfix in calculation of qsws.
137!
138! 3933 2019-04-25 12:33:20Z kanani
139! Remove allocation of pt_2m, this is done in surface_mod now (surfaces%pt_2m)
140!
141! 3921 2019-04-18 14:21:10Z suehring
142! Undo accidentally commented initialization
143!
144! 3918 2019-04-18 13:33:11Z suehring
145! Set green fraction to zero also at vertical surfaces
146!
147! 3914 2019-04-17 16:02:02Z suehring
148! In order to obtain correct surface temperature during spinup set window fraction to zero
149! (only during spinup) instead of just disabling time-integration of window-surface temperature.
150!
151! 3901 2019-04-16 16:17:02Z suehring
152! Workaround - set green fraction to zero ( green-heat model crashes ).
153!
154! 3896 2019-04-15 10:10:17Z suehring
155!
156!
157! 3896 2019-04-15 10:10:17Z suehring
158! Bugfix, wrong index used for accessing building_pars from PIDS
159!
160! 3885 2019-04-11 11:29:34Z kanani
161! Changes related to global restructuring of location messages and introduction of additional debug
162! messages
163!
164! 3882 2019-04-10 11:08:06Z suehring
165! Avoid different type kinds
166! Move definition of building-surface properties from declaration block to an extra routine
167!
168! 3881 2019-04-10 09:31:22Z suehring
169! Revise determination of local ground-floor level height.
170! Make level 3 initalization conform with Palm-input-data standard
171! Move output of albedo and emissivity to radiation module
172!
173! 3832 2019-03-28 13:16:58Z raasch
174! Instrumented with openmp directives
175!
176! 3824 2019-03-27 15:56:16Z pavelkrc
177! Remove unused imports
178!
179!
180! 3814 2019-03-26 08:40:31Z pavelkrc
181! Unused subroutine commented out
182!
183! 3769 2019-02-28 10:16:49Z moh.hefny
184! Removed unused variables
185!
186! 3767 2019-02-27 08:18:02Z raasch
187! Unused variables removed from rrd-subroutines parameter list
188!
189! 3748 2019-02-18 10:38:31Z suehring
190! Revise conversion of waste-heat flux (do not divide by air density, will be done in diffusion_s)
191!
192! 3745 2019-02-15 18:57:56Z suehring
193! - Remove internal flag indoor_model (is a global control parameter)
194! - Add waste heat from buildings to the kinmatic heat flux
195! - Consider waste heat in restart data
196! - Remove unused USE statements
197!
198! 3744 2019-02-15 18:38:58Z suehring
199! Fixed surface heat capacity in the building parameters convert the file back to unix format
200!
201! 3730 2019-02-11 11:26:47Z moh.hefny
202! Formatting and clean-up (rvtils)
203!
204! 3710 2019-01-30 18:11:19Z suehring
205! Check if building type is set within a valid range.
206!
207! 3705 2019-01-29 19:56:39Z suehring
208! Make nzb_wall public, required for virtual-measurements
209!
210! 3704 2019-01-29 19:51:41Z suehring
211! Some interface calls moved to module_interface + cleanup
212!
213! 3655 2019-01-07 16:51:22Z knoop
214! Implementation of the PALM module interface
215!
216! 2007 2016-08-24 15:47:17Z kanani
217! Initial revision
218!
219!
220! Description:
221! ------------
222! 2016/6/9 - Initial version of the USM (Urban Surface Model)
223!            authors: Jaroslav Resler, Pavel Krc (Czech Technical University in Prague and Institute
224!            of Computer Science of the Czech Academy of Sciences, Prague)
225!            with contributions: Michal Belda, Nina Benesova, Ondrej Vlcek
226!            partly inspired by PALM LSM (B. Maronga)
227!            parameterizations of Ra checked with TUF3D (E. S. Krayenhoff)
228!> Module for Urban Surface Model (USM)
229!> The module includes:
230!>    1. Radiation model with direct/diffuse radiation, shading, reflections and integration with
231!>       plant canopy
232!>    2. Wall and wall surface model
233!>    3. Surface layer energy balance
234!>    4. Anthropogenic heat (only from transportation so far)
235!>    5. Necessary auxiliary subroutines (reading inputs, writing outputs, restart simulations, ...)
236!> It also makes use of standard radiation and integrates it into urban surface model.
237!>
238!> Further work:
239!> -------------
240!> @todo Output of _av variables in case of restarts
241!> @todo Revise flux conversion in energy-balance solver
242!> @todo Check divisions in wtend (etc.) calculations for possible division by zero, e.g. in case
243!> fraq(0,m) + fraq(1,m) = 0?!
244!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
245!> @todo Remove reading of old csv inputs
246!--------------------------------------------------------------------------------------------------!
247 MODULE urban_surface_mod
248
249    USE arrays_3d,                                                                                 &
250        ONLY:  exner,                                                                              &
251               hyp,                                                                                &
252               hyrho,                                                                              &
253               p,                                                                                  &
254               prr,                                                                                &
255               pt,                                                                                 &
256               q,                                                                                  &
257               ql,                                                                                 &
258               tend,                                                                               &
259               u,                                                                                  &
260               v,                                                                                  &
261               vpt,                                                                                &
262               w,                                                                                  &
263               zu
264
265    USE calc_mean_profile_mod,                                                                     &
266        ONLY:  calc_mean_profile
267
268    USE basic_constants_and_equations_mod,                                                         &
269        ONLY:  c_p,                                                                                &
270               g,                                                                                  &
271               kappa,                                                                              &
272               l_v,                                                                                &
273               pi,                                                                                 &
274               r_d,                                                                                &
275               rho_l,                                                                              &
276               sigma_sb
277
278    USE control_parameters,                                                                        &
279        ONLY:  average_count_3d,                                                                   &
280               coupling_char,                                                                      &
281               coupling_start_time,                                                                &
282               debug_output,                                                                       &
283               debug_output_timestep,                                                              &
284               debug_string,                                                                       &
285               dt_do3d,                                                                            &
286               dt_3d,                                                                              &
287               dz,                                                                                 &
288               end_time,                                                                           &
289               humidity,                                                                           &
290               indoor_model,                                                                       &
291               initializing_actions,                                                               &
292               intermediate_timestep_count,                                                        &
293               intermediate_timestep_count_max,                                                    &
294               io_blocks,                                                                          &
295               io_group,                                                                           &
296               large_scale_forcing,                                                                &
297               lsf_surf,                                                                           &
298               message_string,                                                                     &
299               pt_surface,                                                                         &
300               restart_data_format_output,                                                         &
301               simulated_time,                                                                     &
302               surface_pressure,                                                                   &
303               spinup_pt_mean,                                                                     &
304               spinup_time,                                                                        &
305               time_do3d,                                                                          &
306               time_since_reference_point,                                                         &
307               timestep_scheme,                                                                    &
308               topography,                                                                         &
309               tsc,                                                                                &
310               urban_surface,                                                                      &
311               varnamelength
312
313
314    USE bulk_cloud_model_mod,                                                                      &
315        ONLY:  bulk_cloud_model,                                                                   &
316               precipitation
317
318    USE cpulog,                                                                                    &
319        ONLY:  cpu_log,                                                                            &
320               log_point,                                                                          &
321               log_point_s
322
323    USE grid_variables,                                                                            &
324        ONLY:  ddx,                                                                                &
325               ddx2,                                                                               &
326               ddy,                                                                                &
327               ddy2,                                                                               &
328               dx,                                                                                 &
329               dy
330
331    USE indices,                                                                                   &
332        ONLY:  nbgp,                                                                               &
333               nnx,                                                                                &
334               nny,                                                                                &
335               nnz,                                                                                &
336               nx,                                                                                 &
337               nxl,                                                                                &
338               nxlg,                                                                               &
339               nxr,                                                                                &
340               nxrg,                                                                               &
341               ny,                                                                                 &
342               nyn,                                                                                &
343               nyng,                                                                               &
344               nys,                                                                                &
345               nysg,                                                                               &
346               nzb,                                                                                &
347               nzt,                                                                                &
348               topo_top_ind
349
350    USE, INTRINSIC :: iso_c_binding
351
352    USE kinds
353
354    USE palm_date_time_mod,                                                                        &
355        ONLY:  get_date_time,                                                                      &
356               seconds_per_hour
357
358    USE pegrid
359
360    USE radiation_model_mod,                                                                       &
361        ONLY:  albedo_type,                                                                        &
362               force_radiation_call,                                                               &
363               id,                                                                                 &
364               ieast_l,                                                                            &
365               ieast_u,                                                                            &
366               inorth_l,                                                                           &
367               inorth_u,                                                                           &
368               isouth_l,                                                                           &
369               isouth_u,                                                                           &
370               iup_l,                                                                              &
371               iup_u,                                                                              &
372               iwest_l,                                                                            &
373               iwest_u,                                                                            &
374               nz_urban_b,                                                                         &
375               nz_urban_t,                                                                         &
376               radiation_interaction,                                                              &
377               radiation,                                                                          &
378               rad_lw_in,                                                                          &
379               rad_lw_out,                                                                         &
380               rad_sw_in,                                                                          &
381               rad_sw_out,                                                                         &
382               unscheduled_radiation_calls
383
384    USE restart_data_mpi_io_mod,                                                                   &
385        ONLY:  rd_mpi_io_surface_filetypes,                                                        &
386               rrd_mpi_io,                                                                         &
387               rrd_mpi_io_surface,                                                                 &
388               wrd_mpi_io,                                                                         &
389               wrd_mpi_io_surface
390
391    USE statistics,                                                                                &
392        ONLY:  hom,                                                                                &
393               statistic_regions
394
395    USE surface_mod,                                                                               &
396        ONLY:  ind_pav_green,                                                                      &
397               ind_veg_wall,                                                                       &
398               ind_wat_win,                                                                        &
399               surf_usm_h,                                                                         &
400               surf_usm_v,                                                                         &
401               surface_restore_elements
402
403
404    IMPLICIT NONE
405
406!
407!-- USM model constants
408
409    REAL(wp), PARAMETER ::  b_ch               = 6.04_wp    !< Clapp & Hornberger exponent
410    REAL(wp), PARAMETER ::  lambda_h_green_dry = 0.19_wp    !< heat conductivity for dry soil
411    REAL(wp), PARAMETER ::  lambda_h_green_sm  = 3.44_wp    !< heat conductivity of the soil matrix
412    REAL(wp), PARAMETER ::  lambda_h_water     = 0.57_wp    !< heat conductivity of water
413    REAL(wp), PARAMETER ::  psi_sat            = -0.388_wp  !< soil matrix potential at saturation
414    REAL(wp), PARAMETER ::  rho_c_soil         = 2.19E6_wp  !< volumetric heat capacity of soil
415    REAL(wp), PARAMETER ::  rho_c_water        = 4.20E6_wp  !< volumetric heat capacity of water
416!    REAL(wp), PARAMETER ::  m_max_depth        = 0.0002_wp  !< Maximum capacity of the water reservoir (m)
417
418!
419!-- Soil parameters I           alpha_vg,      l_vg_green,    n_vg, gamma_w_green_sat
420    REAL(wp), DIMENSION(0:3,1:7), PARAMETER ::  soil_pars = RESHAPE( (/     &
421                                 3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, &  !< soil 1
422                                 3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, &  !< soil 2
423                                 0.83_wp, -0.588_wp, 1.25_wp,  0.26E-6_wp, &  !< soil 3
424                                 3.67_wp, -1.977_wp, 1.10_wp,  2.87E-6_wp, &  !< soil 4
425                                 2.65_wp,  2.500_wp, 1.10_wp,  1.74E-6_wp, &  !< soil 5
426                                 1.30_wp,  0.400_wp, 1.20_wp,  0.93E-6_wp, &  !< soil 6
427                                 0.00_wp,  0.00_wp,  0.00_wp,  0.57E-6_wp  &  !< soil 7
428                                 /), (/ 4, 7 /) )
429
430!
431!-- Soil parameters II              swc_sat,     fc,   wilt,    swc_res
432    REAL(wp), DIMENSION(0:3,1:7), PARAMETER ::  m_soil_pars = RESHAPE( (/ &
433                                 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp, &  !< soil 1
434                                 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp, &  !< soil 2
435                                 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp, &  !< soil 3
436                                 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp, &  !< soil 4
437                                 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp, &  !< soil 5
438                                 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp, &  !< soil 6
439                                 0.472_wp, 0.323_wp, 0.171_wp, 0.000_wp  &  !< soil 7
440                                 /), (/ 4, 7 /) )
441!
442!-- Value 9999999.9_wp -> Generic available or user-defined value must be set otherwise
443!-- -> No generic variable and user setting is optional
444    REAL(wp) ::  alpha_vangenuchten = 9999999.9_wp      !< NAMELIST alpha_vg
445    REAL(wp) ::  field_capacity = 9999999.9_wp          !< NAMELIST fc
446    REAL(wp) ::  hydraulic_conductivity = 9999999.9_wp  !< NAMELIST gamma_w_green_sat
447    REAL(wp) ::  l_vangenuchten = 9999999.9_wp          !< NAMELIST l_vg
448    REAL(wp) ::  n_vangenuchten = 9999999.9_wp          !< NAMELIST n_vg
449    REAL(wp) ::  residual_moisture = 9999999.9_wp       !< NAMELIST m_res
450    REAL(wp) ::  saturation_moisture = 9999999.9_wp     !< NAMELIST m_sat
451    REAL(wp) ::  wilting_point = 9999999.9_wp           !< NAMELIST m_wilt
452
453!
454!-- Configuration parameters (they can be setup in PALM config)
455    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
456    LOGICAL ::  read_wall_temp_3d = .FALSE.        !<
457    LOGICAL ::  usm_anthropogenic_heat = .FALSE.   !< flag parameter indicating wheather the anthropogenic heat sources
458                                                   !< (e.g.transportation) are used
459    LOGICAL ::  usm_material_model = .TRUE.        !< flag parameter indicating wheather the  model of heat in materials is used
460    LOGICAL ::  usm_wall_mod = .FALSE.             !< reduces conductivity of the first 2 wall layers by factor 0.1
461
462
463    INTEGER(iwp) ::  building_type = 1               !< default building type (preleminary setting)
464    INTEGER(iwp) ::  land_category = 2               !< default category for land surface
465    INTEGER(iwp) ::  pedestrian_category = 2         !< default category for wall surface in pedestrian zone
466    INTEGER(iwp) ::  roof_category = 2               !< default category for root surface
467    INTEGER(iwp) ::  wall_category = 2               !< default category for wall surface over pedestrian zone
468
469    REAL(wp)     ::  d_roughness_concrete            !< inverse roughness length of average concrete surface
470    REAL(wp)     ::  roughness_concrete = 0.001_wp   !< roughness length of average concrete surface
471
472!
473!-- Indices of input attributes in building_pars for (above) ground floor level
474    INTEGER(iwp) ::  ind_alb_wall_agfl     = 38   !< index in input list for albedo_type of wall above ground floor level
475    INTEGER(iwp) ::  ind_alb_wall_gfl      = 66   !< index in input list for albedo_type of wall ground floor level
476    INTEGER(iwp) ::  ind_alb_wall_r        = 101  !< index in input list for albedo_type of wall roof
477    INTEGER(iwp) ::  ind_alb_green_agfl    = 39   !< index in input list for albedo_type of green above ground floor level
478    INTEGER(iwp) ::  ind_alb_green_gfl     = 78   !< index in input list for albedo_type of green ground floor level
479    INTEGER(iwp) ::  ind_alb_green_r       = 117  !< index in input list for albedo_type of green roof
480    INTEGER(iwp) ::  ind_alb_win_agfl      = 40   !< index in input list for albedo_type of window fraction above ground floor
481                                                  !< level
482    INTEGER(iwp) ::  ind_alb_win_gfl       = 77   !< index in input list for albedo_type of window fraction ground floor level
483    INTEGER(iwp) ::  ind_alb_win_r         = 115  !< index in input list for albedo_type of window fraction roof
484    INTEGER(iwp) ::  ind_emis_wall_agfl    = 14   !< index in input list for wall emissivity, above ground floor level
485    INTEGER(iwp) ::  ind_emis_wall_gfl     = 32   !< index in input list for wall emissivity, ground floor level
486    INTEGER(iwp) ::  ind_emis_wall_r       = 100  !< index in input list for wall emissivity, roof
487    INTEGER(iwp) ::  ind_emis_green_agfl   = 15   !< index in input list for green emissivity, above ground floor level
488    INTEGER(iwp) ::  ind_emis_green_gfl    = 34   !< index in input list for green emissivity, ground floor level
489    INTEGER(iwp) ::  ind_emis_green_r      = 116  !< index in input list for green emissivity, roof
490    INTEGER(iwp) ::  ind_emis_win_agfl     = 16   !< index in input list for window emissivity, above ground floor level
491    INTEGER(iwp) ::  ind_emis_win_gfl      = 33   !< index in input list for window emissivity, ground floor level
492    INTEGER(iwp) ::  ind_emis_win_r        = 113  !< index in input list for window emissivity, roof
493    INTEGER(iwp) ::  ind_gflh              = 20   !< index in input list for ground floor level height
494    INTEGER(iwp) ::  ind_green_frac_w_agfl = 2    !< index in input list for green fraction on wall, above ground floor level
495    INTEGER(iwp) ::  ind_green_frac_w_gfl  = 23   !< index in input list for green fraction on wall, ground floor level
496    INTEGER(iwp) ::  ind_green_frac_r_agfl = 3    !< index in input list for green fraction on roof, above ground floor level
497    INTEGER(iwp) ::  ind_green_frac_r_gfl  = 24   !< index in input list for green fraction on roof, ground floor level
498    INTEGER(iwp) ::  ind_green_type_roof   = 118  !< index in input list for type of green roof
499    INTEGER(iwp) ::  ind_hc1_agfl          = 6    !< index in input list for heat capacity at first wall layer,
500                                                  !< above ground floor level
501    INTEGER(iwp) ::  ind_hc1_gfl           = 26   !< index in input list for heat capacity at first wall layer, ground floor level
502    INTEGER(iwp) ::  ind_hc1_wall_r        = 94   !< index in input list for heat capacity at first wall layer, roof
503    INTEGER(iwp) ::  ind_hc1_win_agfl      = 83   !< index in input list for heat capacity at first window layer,
504                                                  !< above ground floor level
505    INTEGER(iwp) ::  ind_hc1_win_gfl       = 71   !< index in input list for heat capacity at first window layer,
506                                                  !< ground floor level
507    INTEGER(iwp) ::  ind_hc1_win_r         = 107  !< index in input list for heat capacity at first window layer, roof
508    INTEGER(iwp) ::  ind_hc2_agfl          = 7    !< index in input list for heat capacity at second wall layer,
509                                                  !< above ground floor level
510    INTEGER(iwp) ::  ind_hc2_gfl           = 27   !< index in input list for heat capacity at second wall layer, ground floor level
511    INTEGER(iwp) ::  ind_hc2_wall_r        = 95   !< index in input list for heat capacity at second wall layer, roof
512    INTEGER(iwp) ::  ind_hc2_win_agfl      = 84   !< index in input list for heat capacity at second window layer,
513                                                  !< above ground floor level
514    INTEGER(iwp) ::  ind_hc2_win_gfl       = 72   !< index in input list for heat capacity at second window layer,
515                                                  !< ground floor level
516    INTEGER(iwp) ::  ind_hc2_win_r         = 108  !< index in input list for heat capacity at second window layer, roof
517    INTEGER(iwp) ::  ind_hc3_agfl          = 8    !< index in input list for heat capacity at third wall layer,
518                                                  !< above ground floor level
519    INTEGER(iwp) ::  ind_hc3_gfl           = 28   !< index in input list for heat capacity at third wall layer, ground floor level
520    INTEGER(iwp) ::  ind_hc3_wall_r        = 96   !< index in input list for heat capacity at third wall layer, roof
521    INTEGER(iwp) ::  ind_hc3_win_agfl      = 85   !< index in input list for heat capacity at third window layer,
522                                                  !< above ground floor level
523    INTEGER(iwp) ::  ind_hc3_win_gfl       = 73   !< index in input list for heat capacity at third window layer,
524                                                  !< ground floor level
525    INTEGER(iwp) ::  ind_hc3_win_r         = 109  !< index in input list for heat capacity at third window layer, roof
526    INTEGER(iwp) ::  ind_indoor_target_temp_summer = 12  !<
527    INTEGER(iwp) ::  ind_indoor_target_temp_winter = 13  !<
528    INTEGER(iwp) ::  ind_lai_r_agfl        = 4    !< index in input list for LAI on roof, above ground floor level
529    INTEGER(iwp) ::  ind_lai_r_gfl         = 4    !< index in input list for LAI on roof, ground floor level
530    INTEGER(iwp) ::  ind_lai_w_agfl        = 5    !< index in input list for LAI on wall, above ground floor level
531    INTEGER(iwp) ::  ind_lai_w_gfl         = 25   !< index in input list for LAI on wall, ground floor level
532    INTEGER(iwp) ::  ind_tc1_agfl          = 9    !< index in input list for thermal conductivity at first wall layer,
533                                                  !< above ground floor level
534    INTEGER(iwp) ::  ind_tc1_gfl           = 29   !< index in input list for thermal conductivity at first wall layer,
535                                                  !< ground floor level
536    INTEGER(iwp) ::  ind_tc1_wall_r        = 97   !< index in input list for thermal conductivity at first wall layer, roof
537    INTEGER(iwp) ::  ind_tc1_win_agfl      = 86   !< index in input list for thermal conductivity at first window layer,
538                                                  !< above ground floor level
539    INTEGER(iwp) ::  ind_tc1_win_gfl       = 74   !< index in input list for thermal conductivity at first window layer,
540                                                  !< ground floor level
541    INTEGER(iwp) ::  ind_tc1_win_r         = 110  !< index in input list for thermal conductivity at first window layer, roof
542    INTEGER(iwp) ::  ind_tc2_agfl          = 10   !< index in input list for thermal conductivity at second wall layer,
543                                                  !< above ground floor level
544    INTEGER(iwp) ::  ind_tc2_gfl           = 30   !< index in input list for thermal conductivity at second wall layer,
545                                                  !< ground floor level
546    INTEGER(iwp) ::  ind_tc2_wall_r        = 98   !< index in input list for thermal conductivity at second wall layer, roof
547    INTEGER(iwp) ::  ind_tc2_win_agfl      = 87   !< index in input list for thermal conductivity at second window layer,
548                                                  !< above ground floor level
549    INTEGER(iwp) ::  ind_tc2_win_gfl       = 75   !< index in input list for thermal conductivity at second window layer,
550                                                  !< ground floor level
551    INTEGER(iwp) ::  ind_tc2_win_r         = 111  !< index in input list for thermal conductivity at second window layer,
552                                                  !< ground floor level
553    INTEGER(iwp) ::  ind_tc3_agfl          = 11   !< index in input list for thermal conductivity at third wall layer,
554                                                  !< above ground floor level
555    INTEGER(iwp) ::  ind_tc3_gfl           = 31   !< index in input list for thermal conductivity at third wall layer,
556                                                  !< ground floor level
557    INTEGER(iwp) ::  ind_tc3_wall_r        = 99   !< index in input list for thermal conductivity at third wall layer, roof
558    INTEGER(iwp) ::  ind_tc3_win_agfl      = 88   !< index in input list for thermal conductivity at third window layer,
559                                                  !< above ground floor level
560    INTEGER(iwp) ::  ind_tc3_win_gfl       = 76   !< index in input list for thermal conductivity at third window layer,
561                                                  !< ground floor level
562    INTEGER(iwp) ::  ind_tc3_win_r         = 112  !< index in input list for thermal conductivity at third window layer, roof
563    INTEGER(iwp) ::  ind_thick_1_agfl      = 41   !< index for wall layer thickness - 1st layer above ground floor level
564    INTEGER(iwp) ::  ind_thick_1_gfl       = 62   !< index for wall layer thickness - 1st layer ground floor level
565    INTEGER(iwp) ::  ind_thick_1_wall_r    = 90   !< index for wall layer thickness - 1st layer roof
566    INTEGER(iwp) ::  ind_thick_1_win_agfl  = 79   !< index for window layer thickness - 1st layer above ground floor level
567    INTEGER(iwp) ::  ind_thick_1_win_gfl   = 67   !< index for window layer thickness - 1st layer ground floor level
568    INTEGER(iwp) ::  ind_thick_1_win_r     = 103  !< index for window layer thickness - 1st layer roof
569    INTEGER(iwp) ::  ind_thick_2_agfl      = 42   !< index for wall layer thickness - 2nd layer above ground floor level
570    INTEGER(iwp) ::  ind_thick_2_gfl       = 63   !< index for wall layer thickness - 2nd layer ground floor level
571    INTEGER(iwp) ::  ind_thick_2_wall_r    = 91   !< index for wall layer thickness - 2nd layer roof
572    INTEGER(iwp) ::  ind_thick_2_win_agfl  = 80   !< index for window layer thickness - 2nd layer above ground floor level
573    INTEGER(iwp) ::  ind_thick_2_win_gfl   = 68   !< index for window layer thickness - 2nd layer ground floor level
574    INTEGER(iwp) ::  ind_thick_2_win_r     = 104  !< index for window layer thickness - 2nd layer roof
575    INTEGER(iwp) ::  ind_thick_3_agfl      = 43   !< index for wall layer thickness - 3rd layer above ground floor level
576    INTEGER(iwp) ::  ind_thick_3_gfl       = 64   !< index for wall layer thickness - 3rd layer ground floor level
577    INTEGER(iwp) ::  ind_thick_3_wall_r    = 92   !< index for wall layer thickness - 3rd layer roof
578    INTEGER(iwp) ::  ind_thick_3_win_agfl  = 81   !< index for window layer thickness - 3rd layer above ground floor level
579    INTEGER(iwp) ::  ind_thick_3_win_gfl   = 69   !< index for window layer thickness - 3rd layer ground floor level
580    INTEGER(iwp) ::  ind_thick_3_win_r     = 105  !< index for window layer thickness - 3rd layer roof
581    INTEGER(iwp) ::  ind_thick_4_agfl      = 44   !< index for wall layer thickness - 4th layer above ground floor level
582    INTEGER(iwp) ::  ind_thick_4_gfl       = 65   !< index for wall layer thickness - 4th layer ground floor level
583    INTEGER(iwp) ::  ind_thick_4_wall_r    = 93   !< index for wall layer thickness - 4st layer roof
584    INTEGER(iwp) ::  ind_thick_4_win_agfl  = 82   !< index for window layer thickness - 4th layer above ground floor level
585    INTEGER(iwp) ::  ind_thick_4_win_gfl   = 70   !< index for window layer thickness - 4th layer ground floor level
586    INTEGER(iwp) ::  ind_thick_4_win_r     = 106  !< index for window layer thickness - 4th layer roof
587    INTEGER(iwp) ::  ind_trans_agfl        = 17   !< index in input list for window transmissivity, above ground floor level
588    INTEGER(iwp) ::  ind_trans_gfl         = 35   !< index in input list for window transmissivity, ground floor level
589    INTEGER(iwp) ::  ind_trans_r           = 114  !< index in input list for window transmissivity, roof
590    INTEGER(iwp) ::  ind_wall_frac_agfl    = 0    !< index in input list for wall fraction, above ground floor level
591    INTEGER(iwp) ::  ind_wall_frac_gfl     = 21   !< index in input list for wall fraction, ground floor level
592    INTEGER(iwp) ::  ind_wall_frac_r       = 89   !< index in input list for wall fraction, roof
593    INTEGER(iwp) ::  ind_win_frac_agfl     = 1    !< index in input list for window fraction, above ground floor level
594    INTEGER(iwp) ::  ind_win_frac_gfl      = 22   !< index in input list for window fraction, ground floor level
595    INTEGER(iwp) ::  ind_win_frac_r        = 102  !< index in input list for window fraction, roof
596    INTEGER(iwp) ::  ind_z0_agfl           = 18   !< index in input list for z0, above ground floor level
597    INTEGER(iwp) ::  ind_z0_gfl            = 36   !< index in input list for z0, ground floor level
598    INTEGER(iwp) ::  ind_z0qh_agfl         = 19   !< index in input list for z0h / z0q, above ground floor level
599    INTEGER(iwp) ::  ind_z0qh_gfl          = 37   !< index in input list for z0h / z0q, ground floor level
600!
601!-- Indices of input attributes in building_surface_pars (except for radiation-related, which are in
602!-- radiation_model_mod)
603    CHARACTER(37), DIMENSION(0:7), PARAMETER ::  building_type_name = (/     &
604                                   'user-defined                         ', &  !< type 0
605                                   'residential - 1950                   ', &  !< type  1
606                                   'residential 1951 - 2000              ', &  !< type  2
607                                   'residential 2001 -                   ', &  !< type  3
608                                   'office - 1950                        ', &  !< type  4
609                                   'office 1951 - 2000                   ', &  !< type  5
610                                   'office 2001 -                        ', &  !< type  6
611                                   'bridges                              '  &  !< type  7
612                                                                     /)
613
614    INTEGER(iwp) ::  ind_s_emis_green                = 14  !< index for emissivity of green fraction (0-1)
615    INTEGER(iwp) ::  ind_s_emis_wall                 = 13  !< index for emissivity of wall fraction (0-1)
616    INTEGER(iwp) ::  ind_s_emis_win                  = 15  !< index for emissivity o f window fraction (0-1)
617    INTEGER(iwp) ::  ind_s_green_frac_r              = 3   !< index for green fraction on roof (0-1)
618    INTEGER(iwp) ::  ind_s_green_frac_w              = 2   !< index for green fraction on wall (0-1)
619    INTEGER(iwp) ::  ind_s_hc1                       = 5   !< index for heat capacity of wall layer 1
620    INTEGER(iwp) ::  ind_s_hc2                       = 6   !< index for heat capacity of wall layer 2
621    INTEGER(iwp) ::  ind_s_hc3                       = 7   !< index for heat capacity of wall layer 3
622    INTEGER(iwp) ::  ind_s_indoor_target_temp_summer = 11  !< index for indoor target summer temperature
623    INTEGER(iwp) ::  ind_s_indoor_target_temp_winter = 12  !< index for indoor target winter temperature
624    INTEGER(iwp) ::  ind_s_lai_r                     = 4   !< index for leaf area index of green fraction
625    INTEGER(iwp) ::  ind_s_tc1                       = 8   !< index for thermal conducivity of wall layer 1
626    INTEGER(iwp) ::  ind_s_tc2                       = 9   !< index for thermal conducivity of wall layer 2
627    INTEGER(iwp) ::  ind_s_tc3                       = 10  !< index for thermal conducivity of wall layer 3
628    INTEGER(iwp) ::  ind_s_trans                     = 16  !< index for transmissivity of window fraction (0-1)
629    INTEGER(iwp) ::  ind_s_wall_frac                 = 0   !< index for wall fraction (0-1)
630    INTEGER(iwp) ::  ind_s_win_frac                  = 1   !< index for window fraction (0-1)
631    INTEGER(iwp) ::  ind_s_z0                        = 17  !< index for roughness length for momentum (m)
632    INTEGER(iwp) ::  ind_s_z0qh                      = 18  !< index for roughness length for heat (m)
633
634    REAL(wp)  ::  ground_floor_level = 4.0_wp  !< default ground floor level
635    REAL(wp)  ::  roof_height_limit  = 4.0_wp  !< height to distinguish between land surfaces and roofs
636
637
638!
639!-- Building facade/wall/green/window properties (partly according to PIDS).
640!-- Initialization of building_pars is outsourced to usm_init_pars. This is needed because of the
641!-- huge number of attributes given in building_pars (>700), while intel and gfortran compiler have
642!-- hard limit of continuation lines of 511.
643    REAL(wp), DIMENSION(0:135,1:7) ::  building_pars  !<
644!
645!-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls.
646    TYPE t_surf_vertical
647       REAL(wp), DIMENSION(:), ALLOCATABLE         ::  t  !<
648    END TYPE t_surf_vertical
649!
650!-- Type for wall temperatures at vertical walls. Is not necessary for horizontal walls.
651    TYPE t_wall_vertical
652       REAL(wp), DIMENSION(:,:), ALLOCATABLE       ::  t  !<
653    END TYPE t_wall_vertical
654
655    TYPE surf_type_usm
656       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_usm_1d  !< 1D prognostic variable
657       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_usm_2d  !< 2D prognostic variable
658    END TYPE surf_type_usm
659
660    TYPE(surf_type_usm), POINTER  ::  m_liq_usm_h    !< liquid water reservoir (m), horizontal surface elements
661    TYPE(surf_type_usm), POINTER  ::  m_liq_usm_h_p  !< progn. liquid water reservoir (m), horizontal surface elements
662
663    TYPE(surf_type_usm), TARGET   ::  m_liq_usm_h_1  !<
664    TYPE(surf_type_usm), TARGET   ::  m_liq_usm_h_2  !<
665
666    TYPE(surf_type_usm), TARGET   ::  tm_liq_usm_h_m  !< liquid water reservoir tendency (m), horizontal surface elements
667!
668!-- Anthropogenic heat sources
669    INTEGER(iwp)                                   ::  naheatlayers = 1  !< number of layers of anthropogenic heat
670
671    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE        ::  aheat             !< daily average of anthropogenic heat (W/m2)
672    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  aheatprof         !< diurnal profiles of anthropogenic heat
673                                                                         !< for particular layers
674
675!
676!-- Wall surface model
677!-- Wall surface model constants
678    INTEGER(iwp), PARAMETER                        ::  nzb_wall = 0  !< inner side of the wall model (to be switched)
679    INTEGER(iwp), PARAMETER                        ::  nzt_wall = 3  !< outer side of the wall model (to be switched)
680    INTEGER(iwp), PARAMETER                        ::  nzw      = 4  !< number of wall layers (fixed for now)
681
682    INTEGER(iwp)                                   ::  soil_type     !<
683
684
685    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         ::  zwn_default        = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
686    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         ::  zwn_default_green  = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
687                                                                          !< normalized soil, wall and roof, window and
688                                                                          !< green layer depths (m/m)
689    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         ::  zwn_default_window = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
690
691
692    REAL(wp)  ::  m_total                  = 0.0_wp    !< weighted total water content of the soil (m3/m3)
693    REAL(wp)  ::  roof_inner_temperature   = 295.0_wp  !< temperature of the inner roof
694                                                       !< surface (~22 degrees C) (K)
695    REAL(wp)  ::  soil_inner_temperature   = 288.0_wp  !< temperature of the deep soil
696                                                       !< (~15 degrees C) (K)
697    REAL(wp)  ::  wall_inner_temperature   = 295.0_wp  !< temperature of the inner wall
698                                                       !< surface (~22 degrees C) (K)
699    REAL(wp)  ::  window_inner_temperature = 295.0_wp  !< temperature of the inner window
700                                                       !< surface (~22 degrees C) (K)
701
702!
703!-- Surface and material model variables for walls, ground, roofs
704    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  zwn                 !< normalized wall layer depths (m)
705    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  zwn_green           !< normalized green layer depths (m)
706    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  zwn_window          !< normalized window layer depths (m)
707
708    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_green_h      !<
709    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_green_h_p    !<
710    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_wall_h       !<
711    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_wall_h_p     !<
712    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_window_h     !<
713    REAL(wp), DIMENSION(:), POINTER                ::  t_surf_window_h_p   !<
714
715    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_green_h_1    !<
716    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_green_h_2    !<
717    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_wall_h_1     !<
718    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_wall_h_2     !<
719    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_window_h_1   !<
720    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    ::  t_surf_window_h_2   !<
721
722    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v      !<
723    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v_p    !<
724    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v       !<
725    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v_p     !<
726    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v     !<
727    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v_p   !<
728
729    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v_1    !<
730    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v_2    !<
731    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_wall_v_1     !<
732    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_wall_v_2     !<
733    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v_1   !<
734    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v_2   !<
735
736!
737!-- Energy balance variables
738!-- Parameters of the land, roof and wall surfaces
739    REAL(wp), DIMENSION(:,:), POINTER                ::  fc_h          !<
740    REAL(wp), DIMENSION(:,:), POINTER                ::  rootfr_h      !<
741    REAL(wp), DIMENSION(:,:), POINTER                ::  swc_h         !<
742    REAL(wp), DIMENSION(:,:), POINTER                ::  swc_h_p       !<
743    REAL(wp), DIMENSION(:,:), POINTER                ::  swc_res_h     !<
744    REAL(wp), DIMENSION(:,:), POINTER                ::  swc_sat_h     !<
745    REAL(wp), DIMENSION(:,:), POINTER                ::  t_green_h     !<
746    REAL(wp), DIMENSION(:,:), POINTER                ::  t_green_h_p   !<
747    REAL(wp), DIMENSION(:,:), POINTER                ::  t_wall_h      !<
748    REAL(wp), DIMENSION(:,:), POINTER                ::  t_wall_h_p    !<
749    REAL(wp), DIMENSION(:,:), POINTER                ::  wilt_h        !<
750    REAL(wp), DIMENSION(:,:), POINTER                ::  t_window_h    !<
751    REAL(wp), DIMENSION(:,:), POINTER                ::  t_window_h_p  !<
752
753
754    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  fc_h_1        !<
755    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  rootfr_h_1    !<
756    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  swc_h_1       !<
757    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  swc_h_2       !<
758    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  swc_res_h_1   !<
759    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  swc_sat_h_1   !<
760    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_green_h_1   !<
761    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_green_h_2   !<
762    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_wall_h_1    !<
763    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_wall_h_2    !<
764    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  wilt_h_1      !<
765    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_window_h_1  !<
766    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    ::  t_window_h_2  !<
767
768
769    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_green_v     !<
770    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_green_v_p   !<
771    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_wall_v      !<
772    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_wall_v_p    !<
773    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_window_v    !<
774    TYPE(t_wall_vertical), DIMENSION(:), POINTER   ::  t_window_v_p  !<
775
776
777    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_green_v_1   !<
778    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_green_v_2   !<
779    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_wall_v_1    !<
780    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_wall_v_2    !<
781    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_window_v_1  !<
782    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  ::  t_window_v_2  !<
783
784!
785!-- Surface and material parameter classes (surface_type)
786!-- Albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
787    CHARACTER(12), DIMENSION(:), ALLOCATABLE  ::  surface_type_names    !< names of wall types (used only for reports)
788
789    INTEGER(iwp)                              ::  n_surface_types       !< number of the wall type categories
790
791    INTEGER(iwp), PARAMETER                   ::  ialbedo  = 1          !< albedo of the surface
792    INTEGER(iwp), PARAMETER                   ::  icsurf   = 6          !< Surface skin layer heat capacity (J m-2 K-1 )
793    INTEGER(iwp), PARAMETER                   ::  iemiss   = 2          !< emissivity of the surface
794    INTEGER(iwp), PARAMETER                   ::  ilambdah = 9          !< thermal conductivity lambda H
795                                                                        !< of the wall (W m-1 K-1 )
796    INTEGER(iwp), PARAMETER                   ::  ilambdas = 3          !< heat conductivity lambda S between surface
797                                                                        !< and material ( W m-2 K-1 )
798    INTEGER(iwp), PARAMETER                   ::  irhoC    = 8          !< volumetric heat capacity rho*C of
799                                                                        !< the material ( J m-3 K-1 )
800    INTEGER(iwp), PARAMETER                   ::  irough   = 4          !< roughness length z0 for movements
801    INTEGER(iwp), PARAMETER                   ::  iroughh  = 5          !< roughness length z0h for scalars
802                                                                        !< (heat, humidity,...)
803    INTEGER(iwp), PARAMETER                   ::  ithick   = 7          !< thickness of the surface (wall, roof, land) (m)
804    INTEGER(iwp), PARAMETER                   ::  n_surface_params = 9  !< number of parameters for each type of the wall
805
806
807    INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  surface_type_codes    !< codes of wall types
808
809
810    REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  surface_params        !< parameters of wall types
811
812!
813!-- Interfaces of subroutines accessed from outside of this module
814    INTERFACE usm_3d_data_averaging
815       MODULE PROCEDURE usm_3d_data_averaging
816    END INTERFACE usm_3d_data_averaging
817
818    INTERFACE usm_boundary_condition
819       MODULE PROCEDURE usm_boundary_condition
820    END INTERFACE usm_boundary_condition
821
822    INTERFACE usm_check_data_output
823       MODULE PROCEDURE usm_check_data_output
824    END INTERFACE usm_check_data_output
825
826    INTERFACE usm_check_parameters
827       MODULE PROCEDURE usm_check_parameters
828    END INTERFACE usm_check_parameters
829
830    INTERFACE usm_data_output_3d
831       MODULE PROCEDURE usm_data_output_3d
832    END INTERFACE usm_data_output_3d
833
834    INTERFACE usm_define_netcdf_grid
835       MODULE PROCEDURE usm_define_netcdf_grid
836    END INTERFACE usm_define_netcdf_grid
837
838    INTERFACE usm_init
839       MODULE PROCEDURE usm_init
840    END INTERFACE usm_init
841
842    INTERFACE usm_init_arrays
843       MODULE PROCEDURE usm_init_arrays
844    END INTERFACE usm_init_arrays
845
846    INTERFACE usm_material_heat_model
847       MODULE PROCEDURE usm_material_heat_model
848    END INTERFACE usm_material_heat_model
849
850    INTERFACE usm_green_heat_model
851       MODULE PROCEDURE usm_green_heat_model
852    END INTERFACE usm_green_heat_model
853
854    INTERFACE usm_parin
855       MODULE PROCEDURE usm_parin
856    END INTERFACE usm_parin
857
858    INTERFACE usm_rrd_local
859       MODULE PROCEDURE usm_rrd_local_ftn
860       MODULE PROCEDURE usm_rrd_local_mpi
861    END INTERFACE usm_rrd_local
862
863    INTERFACE usm_surface_energy_balance
864       MODULE PROCEDURE usm_surface_energy_balance
865    END INTERFACE usm_surface_energy_balance
866
867    INTERFACE usm_swap_timelevel
868       MODULE PROCEDURE usm_swap_timelevel
869    END INTERFACE usm_swap_timelevel
870
871    INTERFACE usm_wrd_local
872       MODULE PROCEDURE usm_wrd_local
873    END INTERFACE usm_wrd_local
874
875
876    SAVE
877
878    PRIVATE
879
880!
881!-- Public functions
882    PUBLIC usm_boundary_condition,                                                                 &
883           usm_check_data_output,                                                                  &
884           usm_check_parameters,                                                                   &
885           usm_data_output_3d,                                                                     &
886           usm_define_netcdf_grid,                                                                 &
887           usm_init,                                                                               &
888           usm_init_arrays,                                                                        &
889           usm_material_heat_model,                                                                &
890           usm_parin,                                                                              &
891           usm_rrd_local,                                                                          &
892           usm_surface_energy_balance,                                                             &
893           usm_swap_timelevel,                                                                     &
894           usm_wrd_local,                                                                          &
895           usm_3d_data_averaging
896
897!
898!-- Public parameters, constants and initial values
899    PUBLIC building_type,                                                                          &
900           building_pars,                                                                          &
901           nzb_wall,                                                                               &
902           nzt_wall,                                                                               &
903           t_wall_h,                                                                               &
904           t_wall_v,                                                                               &
905           t_window_h,                                                                             &
906           t_window_v,                                                                             &
907           usm_anthropogenic_heat,                                                                 &
908           usm_green_heat_model,                                                                   &
909           usm_material_model,                                                                     &
910           usm_wall_mod
911
912
913
914
915
916
917 CONTAINS
918
919!--------------------------------------------------------------------------------------------------!
920! Description:
921! ------------
922!> This subroutine creates the necessary indices of the urban surfaces and plant canopy and it
923!> allocates the needed arrays for USM
924!--------------------------------------------------------------------------------------------------!
925 SUBROUTINE usm_init_arrays
926
927    IMPLICIT NONE
928
929    INTEGER(iwp) ::  l  !<
930
931    IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'start' )
932
933!
934!-- Allocate radiation arrays which are part of the new data type.
935!-- For horizontal surfaces.
936    ALLOCATE ( surf_usm_h%surfhf(1:surf_usm_h%ns)    )
937    ALLOCATE ( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
938!
939!-- For vertical surfaces
940    DO  l = 0, 3
941       ALLOCATE ( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns)    )
942       ALLOCATE ( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
943    ENDDO
944
945!
946!-- Wall surface model
947!-- Allocate arrays for wall surface model and define pointers
948!-- Allocate array of wall types and wall parameters
949    ALLOCATE ( surf_usm_h%surface_types(1:surf_usm_h%ns)      )
950    ALLOCATE ( surf_usm_h%building_type(1:surf_usm_h%ns)      )
951    ALLOCATE ( surf_usm_h%building_type_name(1:surf_usm_h%ns) )
952    surf_usm_h%building_type      = 0
953    surf_usm_h%building_type_name = 'none'
954    DO  l = 0, 3
955       ALLOCATE ( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns)      )
956       ALLOCATE ( surf_usm_v(l)%building_type(1:surf_usm_v(l)%ns)      )
957       ALLOCATE ( surf_usm_v(l)%building_type_name(1:surf_usm_v(l)%ns) )
958       surf_usm_v(l)%building_type      = 0
959       surf_usm_v(l)%building_type_name = 'none'
960    ENDDO
961!
962!-- Allocate albedo_type and albedo. Each surface element has 3 values, 0: wall fraction,
963!-- 1: green fraction, 2: window fraction.
964    ALLOCATE ( surf_usm_h%albedo_type(1:surf_usm_h%ns,0:2) )
965    ALLOCATE ( surf_usm_h%albedo(1:surf_usm_h%ns,0:2)      )
966    surf_usm_h%albedo_type = albedo_type
967    DO  l = 0, 3
968       ALLOCATE ( surf_usm_v(l)%albedo_type(1:surf_usm_v(l)%ns,0:2) )
969       ALLOCATE ( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2)      )
970       surf_usm_v(l)%albedo_type = albedo_type
971    ENDDO
972
973!
974!-- Allocate indoor target temperature for summer and winter
975    ALLOCATE ( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
976    ALLOCATE ( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
977    DO  l = 0, 3
978       ALLOCATE ( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
979       ALLOCATE ( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
980    ENDDO
981!
982!-- In case the indoor model is applied, allocate memory for waste heat and indoor temperature.
983    IF ( indoor_model )  THEN
984       ALLOCATE ( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
985       surf_usm_h%waste_heat = 0.0_wp
986       DO  l = 0, 3
987          ALLOCATE ( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
988          surf_usm_v(l)%waste_heat = 0.0_wp
989       ENDDO
990    ENDIF
991!
992!-- Allocate flag indicating ground floor level surface elements
993    ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) )
994    DO  l = 0, 3
995       ALLOCATE ( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
996    ENDDO
997!
998!--  Allocate arrays for relative surface fraction.
999!--  0 - wall fraction, 1 - green fraction, 2 - window fraction
1000     ALLOCATE ( surf_usm_h%frac(1:surf_usm_h%ns,0:2) )
1001     surf_usm_h%frac = 0.0_wp
1002     DO  l = 0, 3
1003        ALLOCATE ( surf_usm_v(l)%frac(1:surf_usm_v(l)%ns,0:2) )
1004        surf_usm_v(l)%frac = 0.0_wp
1005     ENDDO
1006
1007!
1008!-- Wall and roof surface parameters. First for horizontal surfaces
1009    ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)        )
1010    ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)        )
1011    ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
1012    ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns)  )
1013    ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)          )
1014    ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns)   )
1015    ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns)    )
1016    ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns)     )
1017    ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns)                )
1018    ALLOCATE ( surf_usm_h%emissivity(1:surf_usm_h%ns,0:2)     )
1019    ALLOCATE ( surf_usm_h%r_a(1:surf_usm_h%ns)                )
1020    ALLOCATE ( surf_usm_h%r_a_green(1:surf_usm_h%ns)          )
1021    ALLOCATE ( surf_usm_h%r_a_window(1:surf_usm_h%ns)         )
1022    ALLOCATE ( surf_usm_h%green_type_roof(1:surf_usm_h%ns)    )
1023    ALLOCATE ( surf_usm_h%r_s(1:surf_usm_h%ns)                )
1024
1025!
1026!-- For vertical surfaces.
1027    DO  l = 0, 3
1028       ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)        )
1029       ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)          )
1030       ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
1031       ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns)   )
1032       ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns)  )
1033       ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns)    )
1034       ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns)     )
1035       ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns)                )
1036       ALLOCATE ( surf_usm_v(l)%emissivity(1:surf_usm_v(l)%ns,0:2)     )
1037       ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns)                )
1038       ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns)          )
1039       ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns)         )
1040       ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns)                )
1041    ENDDO
1042
1043!
1044!-- Allocate wall and roof material parameters. First for horizontal surfaces
1045    ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)                    )
1046    ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
1047    ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns)                   )
1048    ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1049    ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns)      )
1050    ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1051    ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1052    ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1053    ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
1054
1055    ALLOCATE ( surf_usm_h%rho_c_total_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1056    ALLOCATE ( surf_usm_h%n_vg_green(1:surf_usm_h%ns)                             )
1057    ALLOCATE ( surf_usm_h%alpha_vg_green(1:surf_usm_h%ns)                         )
1058    ALLOCATE ( surf_usm_h%l_vg_green(1:surf_usm_h%ns)                             )
1059    ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1060    ALLOCATE ( surf_usm_h%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1061    ALLOCATE ( surf_usm_h%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1062    ALLOCATE ( surf_usm_h%tswc_h_m(nzb_wall:nzt_wall,1:surf_usm_h%ns)             )
1063
1064!
1065!-- For vertical surfaces.
1066    DO  l = 0, 3
1067       ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns)                    )
1068       ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns)                  )
1069       ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns)                   )
1070       ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1071       ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)      )
1072       ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1073       ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1074       ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1075       ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)     )
1076    ENDDO
1077
1078!
1079!-- Allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
1080    ALLOCATE ( surf_usm_h%g_d(1:surf_usm_h%ns)              )
1081    ALLOCATE ( surf_usm_h%c_liq(1:surf_usm_h%ns)            )
1082    ALLOCATE ( surf_usm_h%qsws_liq(1:surf_usm_h%ns)         )
1083    ALLOCATE ( surf_usm_h%qsws_veg(1:surf_usm_h%ns)         )
1084    ALLOCATE ( surf_usm_h%r_canopy(1:surf_usm_h%ns)         )
1085    ALLOCATE ( surf_usm_h%r_canopy_min(1:surf_usm_h%ns)     )
1086    ALLOCATE ( surf_usm_h%pt_10cm(1:surf_usm_h%ns)          )
1087
1088!
1089!-- For vertical surfaces.
1090    DO  l = 0, 3
1091      ALLOCATE ( surf_usm_v(l)%g_d(1:surf_usm_v(l)%ns)              )
1092      ALLOCATE ( surf_usm_v(l)%c_liq(1:surf_usm_v(l)%ns)            )
1093      ALLOCATE ( surf_usm_v(l)%qsws_liq(1:surf_usm_v(l)%ns)         )
1094      ALLOCATE ( surf_usm_v(l)%qsws_veg(1:surf_usm_v(l)%ns)         )
1095      ALLOCATE ( surf_usm_v(l)%r_canopy(1:surf_usm_v(l)%ns)         )
1096      ALLOCATE ( surf_usm_v(l)%r_canopy_min(1:surf_usm_v(l)%ns)     )
1097      ALLOCATE ( surf_usm_v(l)%pt_10cm(1:surf_usm_v(l)%ns)          )
1098    ENDDO
1099
1100!
1101!-- Allocate wall and roof layers sizes. For horizontal surfaces.
1102    ALLOCATE ( zwn(nzb_wall:nzt_wall)                                        )
1103    ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)       )
1104    ALLOCATE ( zwn_window(nzb_wall:nzt_wall)                                 )
1105    ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1106    ALLOCATE ( zwn_green(nzb_wall:nzt_wall)                                  )
1107    ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1108    ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1109    ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1110    ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1111    ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns)              )
1112    ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
1113    ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1114    ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1115    ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1116    ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1117    ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1118    ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1119    ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1120
1121!
1122!-- For vertical surfaces.
1123    DO  l = 0, 3
1124       ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)       )
1125       ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1126       ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1127       ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1128       ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1129       ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1130       ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)              )
1131       ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
1132       ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1133       ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1134       ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)       )
1135       ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1136       ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1137       ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1138       ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1139    ENDDO
1140
1141!
1142!-- Allocate wall and roof temperature arrays, for horizontal walls.
1143!-- Allocate if required. Note, in case of restarts, some of these arrays might be already allocated.
1144    IF ( .NOT. ALLOCATED( t_surf_wall_h_1 ) )                                                      &
1145       ALLOCATE ( t_surf_wall_h_1(1:surf_usm_h%ns) )
1146    IF ( .NOT. ALLOCATED( t_surf_wall_h_2 ) )                                                      &
1147       ALLOCATE ( t_surf_wall_h_2(1:surf_usm_h%ns) )
1148    IF ( .NOT. ALLOCATED( t_wall_h_1 ) )                                                           &
1149       ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1150    IF ( .NOT. ALLOCATED( t_wall_h_2 ) )                                                           &
1151       ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1152    IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) )                                                    &
1153       ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
1154    IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) )                                                    &
1155       ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
1156    IF ( .NOT. ALLOCATED( t_window_h_1 ) )                                                         &
1157       ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1158    IF ( .NOT. ALLOCATED( t_window_h_2 ) )                                                         &
1159       ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1160    IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) )                                                     &
1161       ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
1162    IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) )                                                     &
1163       ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
1164    IF ( .NOT. ALLOCATED( t_green_h_1 ) )                                                          &
1165       ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1166    IF ( .NOT. ALLOCATED( t_green_h_2 ) )                                                          &
1167       ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1168    IF ( .NOT. ALLOCATED( swc_h_1 ) )                                                              &
1169       ALLOCATE ( swc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1170    IF ( .NOT. ALLOCATED( swc_sat_h_1 ) )                                                          &
1171       ALLOCATE ( swc_sat_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1172    IF ( .NOT. ALLOCATED( swc_res_h_1 ) )                                                          &
1173       ALLOCATE ( swc_res_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1174    IF ( .NOT. ALLOCATED( swc_h_2 ) )                                                              &
1175       ALLOCATE ( swc_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1176    IF ( .NOT. ALLOCATED( rootfr_h_1 ) )                                                           &
1177       ALLOCATE ( rootfr_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1178    IF ( .NOT. ALLOCATED( wilt_h_1 ) )                                                             &
1179       ALLOCATE ( wilt_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1180    IF ( .NOT. ALLOCATED( fc_h_1 ) )                                                               &
1181       ALLOCATE ( fc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1182
1183    IF ( .NOT. ALLOCATED( m_liq_usm_h_1%var_usm_1d ) )                                             &
1184       ALLOCATE ( m_liq_usm_h_1%var_usm_1d(1:surf_usm_h%ns) )
1185    IF ( .NOT. ALLOCATED( m_liq_usm_h_2%var_usm_1d ) )                                             &
1186       ALLOCATE ( m_liq_usm_h_2%var_usm_1d(1:surf_usm_h%ns) )
1187
1188!
1189!-- Initial assignment of the pointers
1190    t_wall_h    => t_wall_h_1;   t_wall_h_p   => t_wall_h_2
1191    t_window_h  => t_window_h_1; t_window_h_p => t_window_h_2
1192    t_green_h   => t_green_h_1;  t_green_h_p  => t_green_h_2
1193    t_surf_wall_h   => t_surf_wall_h_1;   t_surf_wall_h_p   => t_surf_wall_h_2
1194    t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2
1195    t_surf_green_h  => t_surf_green_h_1;  t_surf_green_h_p  => t_surf_green_h_2
1196    m_liq_usm_h     => m_liq_usm_h_1;     m_liq_usm_h_p     => m_liq_usm_h_2
1197    swc_h     => swc_h_1; swc_h_p => swc_h_2
1198    swc_sat_h => swc_sat_h_1
1199    swc_res_h => swc_res_h_1
1200    rootfr_h  => rootfr_h_1
1201    wilt_h    => wilt_h_1
1202    fc_h      => fc_h_1
1203
1204!
1205!-- Allocate wall and roof temperature arrays, for vertical walls if required.
1206!-- Allocate if required. Note, in case of restarts, some of these arrays might be already allocated.
1207    DO  l = 0, 3
1208       IF ( .NOT. ALLOCATED( t_surf_wall_v_1(l)%t ) )                                              &
1209          ALLOCATE ( t_surf_wall_v_1(l)%t(1:surf_usm_v(l)%ns) )
1210       IF ( .NOT. ALLOCATED( t_surf_wall_v_2(l)%t ) )                                              &
1211          ALLOCATE ( t_surf_wall_v_2(l)%t(1:surf_usm_v(l)%ns) )
1212       IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) )                                                   &
1213          ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1214       IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) )                                                   &
1215          ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1216       IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) )                                            &
1217          ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
1218       IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) )                                            &
1219          ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
1220       IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                                                 &
1221          ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1222       IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) )                                                 &
1223          ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1224       IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) )                                             &
1225          ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
1226       IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) )                                             &
1227          ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
1228       IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                                                  &
1229          ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1230       IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) )                                                  &
1231          ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1232    ENDDO
1233!
1234!-- Initial assignment of the pointers
1235    t_wall_v        => t_wall_v_1;        t_wall_v_p        => t_wall_v_2
1236    t_surf_wall_v   => t_surf_wall_v_1;   t_surf_wall_v_p   => t_surf_wall_v_2
1237    t_window_v      => t_window_v_1;      t_window_v_p      => t_window_v_2
1238    t_green_v       => t_green_v_1;       t_green_v_p       => t_green_v_2
1239    t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
1240    t_surf_green_v  => t_surf_green_v_1;  t_surf_green_v_p  => t_surf_green_v_2
1241
1242!
1243!-- Allocate intermediate timestep arrays. For horizontal surfaces.
1244    ALLOCATE ( surf_usm_h%tt_surface_wall_m(1:surf_usm_h%ns)               )
1245    ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)   )
1246    ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns)             )
1247    ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1248    ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1249    ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns)              )
1250
1251!
1252!-- Allocate intermediate timestep arrays
1253!-- Horizontal surfaces
1254    ALLOCATE ( tm_liq_usm_h_m%var_usm_1d(1:surf_usm_h%ns) )
1255    tm_liq_usm_h_m%var_usm_1d = 0.0_wp
1256!
1257!-- Set inital values for prognostic quantities
1258    IF ( ALLOCATED( surf_usm_h%tt_surface_wall_m )   )  surf_usm_h%tt_surface_wall_m   = 0.0_wp
1259    IF ( ALLOCATED( surf_usm_h%tt_wall_m )           )  surf_usm_h%tt_wall_m           = 0.0_wp
1260    IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) )  surf_usm_h%tt_surface_window_m = 0.0_wp
1261    IF ( ALLOCATED( surf_usm_h%tt_window_m    )      )  surf_usm_h%tt_window_m         = 0.0_wp
1262    IF ( ALLOCATED( surf_usm_h%tt_green_m    )       )  surf_usm_h%tt_green_m          = 0.0_wp
1263    IF ( ALLOCATED( surf_usm_h%tt_surface_green_m )  )  surf_usm_h%tt_surface_green_m  = 0.0_wp
1264!
1265!-- Now, for vertical surfaces
1266    DO  l = 0, 3
1267       ALLOCATE ( surf_usm_v(l)%tt_surface_wall_m(1:surf_usm_v(l)%ns) )
1268       ALLOCATE ( surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1269       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_wall_m ) )  surf_usm_v(l)%tt_surface_wall_m = 0.0_wp
1270       IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m ) )  surf_usm_v(l)%tt_wall_m  = 0.0_wp
1271       ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns) )
1272       ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1273       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) )  surf_usm_v(l)%tt_surface_window_m = 0.0_wp
1274       IF ( ALLOCATED( surf_usm_v(l)%tt_window_m ) )  surf_usm_v(l)%tt_window_m = 0.0_wp
1275       ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns) )
1276       IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) )  surf_usm_v(l)%tt_surface_green_m = 0.0_wp
1277       ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1278       IF ( ALLOCATED( surf_usm_v(l)%tt_green_m ) )  surf_usm_v(l)%tt_green_m = 0.0_wp
1279    ENDDO
1280!
1281!-- Allocate wall heat flux output arrays and set initial values. For horizontal surfaces
1282!    ALLOCATE ( surf_usm_h%wshf(1:surf_usm_h%ns)    )  !can be removed
1283    ALLOCATE ( surf_usm_h%ghf(1:surf_usm_h%ns) )
1284    ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
1285    ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
1286    ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
1287    ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
1288    ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
1289    ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
1290    IF ( ALLOCATED( surf_usm_h%ghf     ) )  surf_usm_h%ghf     = 0.0_wp
1291    IF ( ALLOCATED( surf_usm_h%wshf    ) )  surf_usm_h%wshf    = 0.0_wp
1292    IF ( ALLOCATED( surf_usm_h%wshf_eb ) )  surf_usm_h%wshf_eb = 0.0_wp
1293    IF ( ALLOCATED( surf_usm_h%wghf_eb ) )  surf_usm_h%wghf_eb = 0.0_wp
1294    IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) )   surf_usm_h%wghf_eb_window  = 0.0_wp
1295    IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) )    surf_usm_h%wghf_eb_green   = 0.0_wp
1296    IF ( ALLOCATED( surf_usm_h%iwghf_eb ) )         surf_usm_h%iwghf_eb        = 0.0_wp
1297    IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) )  surf_usm_h%iwghf_eb_window = 0.0_wp
1298!
1299!-- Now, for vertical surfaces
1300    DO  l = 0, 3
1301!       ALLOCATE ( surf_usm_v(l)%wshf(1:surf_usm_v(l)%ns)    )    ! can be removed
1302       ALLOCATE ( surf_usm_v(l)%ghf(1:surf_usm_v(l)%ns) )
1303       ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
1304       ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
1305       ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
1306       ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
1307       ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
1308       ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
1309       IF ( ALLOCATED( surf_usm_v(l)%ghf     ) )  surf_usm_v(l)%ghf     = 0.0_wp
1310       IF ( ALLOCATED( surf_usm_v(l)%wshf    ) )  surf_usm_v(l)%wshf    = 0.0_wp
1311       IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) )  surf_usm_v(l)%wshf_eb = 0.0_wp
1312       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) )  surf_usm_v(l)%wghf_eb = 0.0_wp
1313       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) )   surf_usm_v(l)%wghf_eb_window  = 0.0_wp
1314       IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) )    surf_usm_v(l)%wghf_eb_green   = 0.0_wp
1315       IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) )         surf_usm_v(l)%iwghf_eb        = 0.0_wp
1316       IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) )  surf_usm_v(l)%iwghf_eb_window = 0.0_wp
1317    ENDDO
1318!
1319!-- Initialize building-surface properties, which are also required by other modules, e.g. the
1320!-- indoor model.
1321    CALL usm_define_pars
1322
1323    IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'end' )
1324
1325 END SUBROUTINE usm_init_arrays
1326
1327
1328!--------------------------------------------------------------------------------------------------!
1329! Description:
1330! ------------
1331!> Sum up and time-average urban surface output quantities as well as allocate the array necessary
1332!> for storing the average.
1333!--------------------------------------------------------------------------------------------------!
1334 SUBROUTINE usm_3d_data_averaging( mode, variable )
1335
1336    IMPLICIT NONE
1337
1338    CHARACTER(LEN=*), INTENT(IN) ::  variable  !<
1339    CHARACTER(LEN=*), INTENT(IN) ::  mode      !<
1340
1341    INTEGER(iwp)                                       ::  i, j, k, l, m, ids, idsint, iwl, istat  !< runnin indices
1342    CHARACTER(LEN=varnamelength)                       ::  var                                     !< trimmed variable
1343    INTEGER(iwp), PARAMETER                            ::  nd = 5                                  !< number of directions
1344    CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER     ::  dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
1345    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         ::  dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
1346
1347
1348
1349
1350    IF ( variable(1:4) == 'usm_' )  THEN  ! Is such a check really required?
1351
1352!
1353!-- Find the real name of the variable
1354    ids = -1
1355    l = -1
1356    var = TRIM(variable)
1357    DO  i = 0, nd-1
1358       k = len( TRIM( var ) )
1359       j = len( TRIM( dirname(i) ) )
1360       IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
1361           ids = i
1362           idsint = dirint(ids)
1363           var = var(:k-j)
1364           EXIT
1365       ENDIF
1366    ENDDO
1367    l = idsint - 2  ! Horizontal direction index - terrible hack !
1368    IF ( l < 0 .OR. l > 3 )  THEN
1369       l = -1
1370    ENDIF
1371    IF ( ids == -1 )  THEN
1372        var = TRIM( variable )
1373    ENDIF
1374    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
1375!
1376!--      Wall layers
1377        READ( var(12:12), '(I1)', iostat=istat ) iwl
1378        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1379            var = var(1:10)
1380        ELSE
1381!
1382!--         Wrong wall layer index
1383            RETURN
1384        ENDIF
1385    ENDIF
1386    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM(var) ) >= 14 )  THEN
1387!
1388!--      Wall layers
1389        READ( var(14:14), '(I1)', iostat=istat ) iwl
1390        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1391            var = var(1:12)
1392        ELSE
1393!
1394!--         Wrong window layer index
1395            RETURN
1396        ENDIF
1397    ENDIF
1398    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
1399!
1400!--      Wall layers
1401        READ( var(13:13), '(I1)', iostat=istat ) iwl
1402        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1403            var = var(1:11)
1404        ELSE
1405!
1406!--         Wrong green layer index
1407            RETURN
1408        ENDIF
1409    ENDIF
1410    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
1411!
1412!--      Swc layers
1413        READ( var(9:9), '(I1)', iostat=istat ) iwl
1414        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1415            var = var(1:7)
1416        ELSE
1417!
1418!--         Wrong swc layer index
1419            RETURN
1420        ENDIF
1421    ENDIF
1422
1423    IF ( mode == 'allocate' )  THEN
1424
1425       SELECT CASE ( TRIM( var ) )
1426
1427            CASE ( 'usm_wshf' )
1428!
1429!--             Array of sensible heat flux from surfaces
1430!--             Land surfaces
1431                IF ( l == -1 )  THEN
1432                   IF ( .NOT.  ALLOCATED( surf_usm_h%wshf_eb_av ) )  THEN
1433                      ALLOCATE ( surf_usm_h%wshf_eb_av(1:surf_usm_h%ns) )
1434                      surf_usm_h%wshf_eb_av = 0.0_wp
1435                   ENDIF
1436                ELSE
1437                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wshf_eb_av ) )  THEN
1438                       ALLOCATE ( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) )
1439                       surf_usm_v(l)%wshf_eb_av = 0.0_wp
1440                   ENDIF
1441                ENDIF
1442
1443            CASE ( 'usm_qsws' )
1444!
1445!--             Array of latent heat flux from surfaces
1446!--             Land surfaces
1447                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_av ) )  THEN
1448                    ALLOCATE ( surf_usm_h%qsws_av(1:surf_usm_h%ns) )
1449                    surf_usm_h%qsws_av = 0.0_wp
1450                ELSE
1451                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_av ) )  THEN
1452                       ALLOCATE ( surf_usm_v(l)%qsws_av(1:surf_usm_v(l)%ns) )
1453                       surf_usm_v(l)%qsws_av = 0.0_wp
1454                   ENDIF
1455                ENDIF
1456
1457            CASE ( 'usm_qsws_veg' )
1458!
1459!--             Array of latent heat flux from vegetation surfaces
1460!--             Land surfaces
1461                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_veg_av ) )  THEN
1462                    ALLOCATE ( surf_usm_h%qsws_veg_av(1:surf_usm_h%ns) )
1463                    surf_usm_h%qsws_veg_av = 0.0_wp
1464                ELSE
1465                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_veg_av ) )  THEN
1466                       ALLOCATE ( surf_usm_v(l)%qsws_veg_av(1:surf_usm_v(l)%ns) )
1467                       surf_usm_v(l)%qsws_veg_av = 0.0_wp
1468                   ENDIF
1469                ENDIF
1470
1471            CASE ( 'usm_qsws_liq' )
1472!
1473!--             Array of latent heat flux from surfaces with liquid
1474!--             Land surfaces
1475                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_liq_av ) )  THEN
1476                    ALLOCATE ( surf_usm_h%qsws_liq_av(1:surf_usm_h%ns) )
1477                    surf_usm_h%qsws_liq_av = 0.0_wp
1478                ELSE
1479                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%qsws_liq_av ) )  THEN
1480                       ALLOCATE ( surf_usm_v(l)%qsws_liq_av(1:surf_usm_v(l)%ns) )
1481                       surf_usm_v(l)%qsws_liq_av = 0.0_wp
1482                   ENDIF
1483                ENDIF
1484!
1485!--         Please note, the following output quantities belongs to the individual tile fractions -
1486!--         ground heat flux at wall-, window-, and green fraction. Aggregated ground-heat flux is
1487!--         treated accordingly in average_3d_data, sum_up_3d_data, etc..
1488            CASE ( 'usm_wghf' )
1489!
1490!--             Array of heat flux from ground (wall, roof, land)
1491                IF ( l == -1 )  THEN
1492                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_av ) )  THEN
1493                       ALLOCATE ( surf_usm_h%wghf_eb_av(1:surf_usm_h%ns) )
1494                       surf_usm_h%wghf_eb_av = 0.0_wp
1495                   ENDIF
1496                ELSE
1497                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_av ) )  THEN
1498                       ALLOCATE ( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) )
1499                       surf_usm_v(l)%wghf_eb_av = 0.0_wp
1500                   ENDIF
1501                ENDIF
1502
1503            CASE ( 'usm_wghf_window' )
1504!
1505!--             Array of heat flux from window ground (wall, roof, land)
1506                IF ( l == -1 )  THEN
1507                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_window_av ) )  THEN
1508                       ALLOCATE ( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
1509                       surf_usm_h%wghf_eb_window_av = 0.0_wp
1510                   ENDIF
1511                ELSE
1512                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_window_av ) )  THEN
1513                       ALLOCATE ( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
1514                       surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
1515                   ENDIF
1516                ENDIF
1517
1518            CASE ( 'usm_wghf_green' )
1519!
1520!--             Array of heat flux from green ground (wall, roof, land)
1521                IF ( l == -1 )  THEN
1522                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_green_av ) )  THEN
1523                       ALLOCATE ( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
1524                       surf_usm_h%wghf_eb_green_av = 0.0_wp
1525                   ENDIF
1526                ELSE
1527                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%wghf_eb_green_av ) )  THEN
1528                       ALLOCATE ( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
1529                       surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
1530                   ENDIF
1531                ENDIF
1532
1533            CASE ( 'usm_iwghf' )
1534!
1535!--             Array of heat flux from indoor ground (wall, roof, land)
1536                IF ( l == -1 )  THEN
1537                   IF ( .NOT.  ALLOCATED( surf_usm_h%iwghf_eb_av ) )  THEN
1538                       ALLOCATE ( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
1539                       surf_usm_h%iwghf_eb_av = 0.0_wp
1540                   ENDIF
1541                ELSE
1542                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%iwghf_eb_av ) )  THEN
1543                       ALLOCATE ( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
1544                       surf_usm_v(l)%iwghf_eb_av = 0.0_wp
1545                   ENDIF
1546                ENDIF
1547
1548            CASE ( 'usm_iwghf_window' )
1549!
1550!--             Array of heat flux from indoor window ground (wall, roof, land)
1551                IF ( l == -1 ) THEN
1552                   IF ( .NOT.  ALLOCATED( surf_usm_h%iwghf_eb_window_av ) )  THEN
1553                       ALLOCATE ( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
1554                       surf_usm_h%iwghf_eb_window_av = 0.0_wp
1555                   ENDIF
1556                ELSE
1557                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%iwghf_eb_window_av ) )  THEN
1558                       ALLOCATE ( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
1559                       surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
1560                   ENDIF
1561                ENDIF
1562
1563            CASE ( 'usm_t_surf_wall' )
1564!
1565!--             Surface temperature for surfaces
1566                IF ( l == -1 )  THEN
1567                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_wall_av ) )  THEN
1568                       ALLOCATE ( surf_usm_h%t_surf_wall_av(1:surf_usm_h%ns) )
1569                       surf_usm_h%t_surf_wall_av = 0.0_wp
1570                   ENDIF
1571                ELSE
1572                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_wall_av ) )  THEN
1573                       ALLOCATE ( surf_usm_v(l)%t_surf_wall_av(1:surf_usm_v(l)%ns) )
1574                       surf_usm_v(l)%t_surf_wall_av = 0.0_wp
1575                   ENDIF
1576                ENDIF
1577
1578            CASE ( 'usm_t_surf_window' )
1579!
1580!--             Surface temperature for window surfaces
1581                IF ( l == -1 )  THEN
1582                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_window_av ) )  THEN
1583                       ALLOCATE ( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
1584                       surf_usm_h%t_surf_window_av = 0.0_wp
1585                   ENDIF
1586                ELSE
1587                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_window_av ) )  THEN
1588                       ALLOCATE ( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
1589                       surf_usm_v(l)%t_surf_window_av = 0.0_wp
1590                   ENDIF
1591                ENDIF
1592
1593            CASE ( 'usm_t_surf_green' )
1594!
1595!--             Surface temperature for green surfaces
1596                IF ( l == -1 )  THEN
1597                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_green_av ) )  THEN
1598                       ALLOCATE ( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
1599                       surf_usm_h%t_surf_green_av = 0.0_wp
1600                   ENDIF
1601                ELSE
1602                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_surf_green_av ) )  THEN
1603                       ALLOCATE ( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
1604                       surf_usm_v(l)%t_surf_green_av = 0.0_wp
1605                   ENDIF
1606                ENDIF
1607
1608            CASE ( 'usm_theta_10cm' )
1609!
1610!--             Near surface (10cm) temperature for whole surfaces
1611                IF ( l == -1 )  THEN
1612                   IF ( .NOT.  ALLOCATED( surf_usm_h%pt_10cm_av ) )  THEN
1613                       ALLOCATE ( surf_usm_h%pt_10cm_av(1:surf_usm_h%ns) )
1614                       surf_usm_h%pt_10cm_av = 0.0_wp
1615                   ENDIF
1616                ELSE
1617                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%pt_10cm_av ) )  THEN
1618                       ALLOCATE ( surf_usm_v(l)%pt_10cm_av(1:surf_usm_v(l)%ns) )
1619                       surf_usm_v(l)%pt_10cm_av = 0.0_wp
1620                   ENDIF
1621                ENDIF
1622
1623            CASE ( 'usm_t_wall' )
1624!
1625!--             Wall temperature for iwl layer of walls and land
1626                IF ( l == -1 )  THEN
1627                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_wall_av ) )  THEN
1628                       ALLOCATE ( surf_usm_h%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1629                       surf_usm_h%t_wall_av = 0.0_wp
1630                   ENDIF
1631                ELSE
1632                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_wall_av ) )  THEN
1633                       ALLOCATE ( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1634                       surf_usm_v(l)%t_wall_av = 0.0_wp
1635                   ENDIF
1636                ENDIF
1637
1638            CASE ( 'usm_t_window' )
1639!
1640!--             Window temperature for iwl layer of walls and land
1641                IF ( l == -1 )  THEN
1642                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_window_av ) )  THEN
1643                       ALLOCATE ( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1644                       surf_usm_h%t_window_av = 0.0_wp
1645                   ENDIF
1646                ELSE
1647                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_window_av ) )  THEN
1648                       ALLOCATE ( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1649                       surf_usm_v(l)%t_window_av = 0.0_wp
1650                   ENDIF
1651                ENDIF
1652
1653            CASE ( 'usm_t_green' )
1654!
1655!--             Green temperature for iwl layer of walls and land
1656                IF ( l == -1 )  THEN
1657                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_green_av ) )  THEN
1658                       ALLOCATE ( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1659                       surf_usm_h%t_green_av = 0.0_wp
1660                   ENDIF
1661                ELSE
1662                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%t_green_av ) )  THEN
1663                       ALLOCATE ( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1664                       surf_usm_v(l)%t_green_av = 0.0_wp
1665                   ENDIF
1666                ENDIF
1667            CASE ( 'usm_swc' )
1668!
1669!--             Soil water content for iwl layer of walls and land
1670                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%swc_av ) )  THEN
1671                    ALLOCATE ( surf_usm_h%swc_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1672                    surf_usm_h%swc_av = 0.0_wp
1673                ELSE
1674                   IF ( .NOT.  ALLOCATED( surf_usm_v(l)%swc_av ) )  THEN
1675                       ALLOCATE ( surf_usm_v(l)%swc_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1676                       surf_usm_v(l)%swc_av = 0.0_wp
1677                   ENDIF
1678                ENDIF
1679
1680           CASE DEFAULT
1681               CONTINUE
1682
1683       END SELECT
1684
1685    ELSEIF ( mode == 'sum' )  THEN
1686
1687       SELECT CASE ( TRIM( var ) )
1688
1689            CASE ( 'usm_wshf' )
1690!
1691!--             Array of sensible heat flux from surfaces (land, roof, wall)
1692                IF ( l == -1 )  THEN
1693                   DO  m = 1, surf_usm_h%ns
1694                      surf_usm_h%wshf_eb_av(m) = surf_usm_h%wshf_eb_av(m) + surf_usm_h%wshf_eb(m)
1695                   ENDDO
1696                ELSE
1697                   DO  m = 1, surf_usm_v(l)%ns
1698                      surf_usm_v(l)%wshf_eb_av(m) = surf_usm_v(l)%wshf_eb_av(m) +                  &
1699                                                    surf_usm_v(l)%wshf_eb(m)
1700                   ENDDO
1701                ENDIF
1702
1703            CASE ( 'usm_qsws' )
1704!
1705!--             Array of latent heat flux from surfaces (land, roof, wall)
1706                IF ( l == -1 ) THEN
1707                DO  m = 1, surf_usm_h%ns
1708                   surf_usm_h%qsws_av(m) = surf_usm_h%qsws_av(m) + surf_usm_h%qsws(m) * l_v
1709                ENDDO
1710                ELSE
1711                   DO  m = 1, surf_usm_v(l)%ns
1712                      surf_usm_v(l)%qsws_av(m) =  surf_usm_v(l)%qsws_av(m) +                       &
1713                                                  surf_usm_v(l)%qsws(m) * l_v
1714                   ENDDO
1715                ENDIF
1716
1717            CASE ( 'usm_qsws_veg' )
1718!
1719!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
1720                IF ( l == -1 )  THEN
1721                DO  m = 1, surf_usm_h%ns
1722                   surf_usm_h%qsws_veg_av(m) = surf_usm_h%qsws_veg_av(m) + surf_usm_h%qsws_veg(m)
1723                ENDDO
1724                ELSE
1725                   DO  m = 1, surf_usm_v(l)%ns
1726                      surf_usm_v(l)%qsws_veg_av(m) = surf_usm_v(l)%qsws_veg_av(m) +                &
1727                                                     surf_usm_v(l)%qsws_veg(m)
1728                   ENDDO
1729                ENDIF
1730
1731            CASE ( 'usm_qsws_liq' )
1732!
1733!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
1734                IF ( l == -1 ) THEN
1735                DO  m = 1, surf_usm_h%ns
1736                   surf_usm_h%qsws_liq_av(m) = surf_usm_h%qsws_liq_av(m) +                         &
1737                                               surf_usm_h%qsws_liq(m)
1738                ENDDO
1739                ELSE
1740                   DO  m = 1, surf_usm_v(l)%ns
1741                      surf_usm_v(l)%qsws_liq_av(m) = surf_usm_v(l)%qsws_liq_av(m) +                &
1742                                                     surf_usm_v(l)%qsws_liq(m)
1743                   ENDDO
1744                ENDIF
1745
1746            CASE ( 'usm_wghf' )
1747!
1748!--             Array of heat flux from ground (wall, roof, land)
1749                IF ( l == -1 ) THEN
1750                   DO  m = 1, surf_usm_h%ns
1751                      surf_usm_h%wghf_eb_av(m) = surf_usm_h%wghf_eb_av(m) +                        &
1752                                                 surf_usm_h%wghf_eb(m)
1753                   ENDDO
1754                ELSE
1755                   DO  m = 1, surf_usm_v(l)%ns
1756                      surf_usm_v(l)%wghf_eb_av(m) = surf_usm_v(l)%wghf_eb_av(m) +                  &
1757                                                    surf_usm_v(l)%wghf_eb(m)
1758                   ENDDO
1759                ENDIF
1760
1761            CASE ( 'usm_wghf_window' )
1762!
1763!--             Array of heat flux from window ground (wall, roof, land)
1764                IF ( l == -1 )  THEN
1765                   DO  m = 1, surf_usm_h%ns
1766                      surf_usm_h%wghf_eb_window_av(m) = surf_usm_h%wghf_eb_window_av(m) +          &
1767                                                        surf_usm_h%wghf_eb_window(m)
1768                   ENDDO
1769                ELSE
1770                   DO  m = 1, surf_usm_v(l)%ns
1771                      surf_usm_v(l)%wghf_eb_window_av(m) = surf_usm_v(l)%wghf_eb_window_av(m) +    &
1772                                                           surf_usm_v(l)%wghf_eb_window(m)
1773                   ENDDO
1774                ENDIF
1775
1776            CASE ( 'usm_wghf_green' )
1777!
1778!--             Array of heat flux from green ground (wall, roof, land)
1779                IF ( l == -1 )  THEN
1780                   DO  m = 1, surf_usm_h%ns
1781                      surf_usm_h%wghf_eb_green_av(m) = surf_usm_h%wghf_eb_green_av(m) +            &
1782                                                       surf_usm_h%wghf_eb_green(m)
1783                   ENDDO
1784                ELSE
1785                   DO  m = 1, surf_usm_v(l)%ns
1786                      surf_usm_v(l)%wghf_eb_green_av(m) = surf_usm_v(l)%wghf_eb_green_av(m) +      &
1787                                                          surf_usm_v(l)%wghf_eb_green(m)
1788                   ENDDO
1789                ENDIF
1790
1791            CASE ( 'usm_iwghf' )
1792!
1793!--             Array of heat flux from indoor ground (wall, roof, land)
1794                IF ( l == -1 )  THEN
1795                   DO  m = 1, surf_usm_h%ns
1796                      surf_usm_h%iwghf_eb_av(m) = surf_usm_h%iwghf_eb_av(m) + surf_usm_h%iwghf_eb(m)
1797                   ENDDO
1798                ELSE
1799                   DO  m = 1, surf_usm_v(l)%ns
1800                      surf_usm_v(l)%iwghf_eb_av(m) = surf_usm_v(l)%iwghf_eb_av(m) +                &
1801                                                     surf_usm_v(l)%iwghf_eb(m)
1802                   ENDDO
1803                ENDIF
1804
1805            CASE ( 'usm_iwghf_window' )
1806!
1807!--             Array of heat flux from indoor window ground (wall, roof, land)
1808                IF ( l == -1 )  THEN
1809                   DO  m = 1, surf_usm_h%ns
1810                      surf_usm_h%iwghf_eb_window_av(m) = surf_usm_h%iwghf_eb_window_av(m) +        &
1811                                                         surf_usm_h%iwghf_eb_window(m)
1812                   ENDDO
1813                ELSE
1814                   DO  m = 1, surf_usm_v(l)%ns
1815                      surf_usm_v(l)%iwghf_eb_window_av(m) = surf_usm_v(l)%iwghf_eb_window_av(m) +  &
1816                                                            surf_usm_v(l)%iwghf_eb_window(m)
1817                   ENDDO
1818                ENDIF
1819
1820            CASE ( 'usm_t_surf_wall' )
1821!
1822!--             Surface temperature for surfaces
1823                IF ( l == -1 )  THEN
1824                   DO  m = 1, surf_usm_h%ns
1825                   surf_usm_h%t_surf_wall_av(m) = surf_usm_h%t_surf_wall_av(m) + t_surf_wall_h(m)
1826                   ENDDO
1827                ELSE
1828                   DO  m = 1, surf_usm_v(l)%ns
1829                      surf_usm_v(l)%t_surf_wall_av(m) = surf_usm_v(l)%t_surf_wall_av(m) +          &
1830                                                        t_surf_wall_v(l)%t(m)
1831                   ENDDO
1832                ENDIF
1833
1834            CASE ( 'usm_t_surf_window' )
1835!
1836!--             Surface temperature for window surfaces
1837                IF ( l == -1 )  THEN
1838                   DO  m = 1, surf_usm_h%ns
1839                      surf_usm_h%t_surf_window_av(m) = surf_usm_h%t_surf_window_av(m) +            &
1840                                                       t_surf_window_h(m)
1841                   ENDDO
1842                ELSE
1843                   DO  m = 1, surf_usm_v(l)%ns
1844                      surf_usm_v(l)%t_surf_window_av(m) = surf_usm_v(l)%t_surf_window_av(m) +      &
1845                                                          t_surf_window_v(l)%t(m)
1846                   ENDDO
1847                ENDIF
1848
1849            CASE ( 'usm_t_surf_green' )
1850!
1851!--             Surface temperature for green surfaces
1852                IF ( l == -1 )  THEN
1853                   DO  m = 1, surf_usm_h%ns
1854                      surf_usm_h%t_surf_green_av(m) = surf_usm_h%t_surf_green_av(m) +              &
1855                                                      t_surf_green_h(m)
1856                   ENDDO
1857                ELSE
1858                   DO  m = 1, surf_usm_v(l)%ns
1859                      surf_usm_v(l)%t_surf_green_av(m) = surf_usm_v(l)%t_surf_green_av(m) +        &
1860                                                         t_surf_green_v(l)%t(m)
1861                   ENDDO
1862                ENDIF
1863
1864            CASE ( 'usm_theta_10cm' )
1865!
1866!--             Near surface temperature for whole surfaces
1867                IF ( l == -1 )  THEN
1868                   DO  m = 1, surf_usm_h%ns
1869                      surf_usm_h%pt_10cm_av(m) = surf_usm_h%pt_10cm_av(m) +                        &
1870                                                 surf_usm_h%pt_10cm(m)
1871                   ENDDO
1872                ELSE
1873                   DO  m = 1, surf_usm_v(l)%ns
1874                      surf_usm_v(l)%pt_10cm_av(m) = surf_usm_v(l)%pt_10cm_av(m) +                  &
1875                                                    surf_usm_v(l)%pt_10cm(m)
1876                   ENDDO
1877                ENDIF
1878
1879            CASE ( 'usm_t_wall' )
1880!
1881!--             Wall temperature for  iwl layer of walls and land
1882                IF ( l == -1 )  THEN
1883                   DO  m = 1, surf_usm_h%ns
1884                      surf_usm_h%t_wall_av(iwl,m) = surf_usm_h%t_wall_av(iwl,m) +                  &
1885                                                    t_wall_h(iwl,m)
1886                   ENDDO
1887                ELSE
1888                   DO  m = 1, surf_usm_v(l)%ns
1889                      surf_usm_v(l)%t_wall_av(iwl,m) = surf_usm_v(l)%t_wall_av(iwl,m) +            &
1890                                                       t_wall_v(l)%t(iwl,m)
1891                   ENDDO
1892                ENDIF
1893
1894            CASE ( 'usm_t_window' )
1895!
1896!--             Window temperature for  iwl layer of walls and land
1897                IF ( l == -1 )  THEN
1898                   DO  m = 1, surf_usm_h%ns
1899                      surf_usm_h%t_window_av(iwl,m) = surf_usm_h%t_window_av(iwl,m) +              &
1900                                                      t_window_h(iwl,m)
1901                   ENDDO
1902                ELSE
1903                   DO  m = 1, surf_usm_v(l)%ns
1904                      surf_usm_v(l)%t_window_av(iwl,m) = surf_usm_v(l)%t_window_av(iwl,m) +        &
1905                                                         t_window_v(l)%t(iwl,m)
1906                   ENDDO
1907                ENDIF
1908
1909            CASE ( 'usm_t_green' )
1910!
1911!--             Green temperature for  iwl layer of walls and land
1912                IF ( l == -1 )  THEN
1913                   DO  m = 1, surf_usm_h%ns
1914                      surf_usm_h%t_green_av(iwl,m) = surf_usm_h%t_green_av(iwl,m) + t_green_h(iwl,m)
1915                   ENDDO
1916                ELSE
1917                   DO  m = 1, surf_usm_v(l)%ns
1918                      surf_usm_v(l)%t_green_av(iwl,m) = surf_usm_v(l)%t_green_av(iwl,m) +          &
1919                                                        t_green_v(l)%t(iwl,m)
1920                   ENDDO
1921                ENDIF
1922
1923            CASE ( 'usm_swc' )
1924!
1925!--             Soil water content for  iwl layer of walls and land
1926                IF ( l == -1 )  THEN
1927                   DO  m = 1, surf_usm_h%ns
1928                      surf_usm_h%swc_av(iwl,m) = surf_usm_h%swc_av(iwl,m) + swc_h(iwl,m)
1929                   ENDDO
1930                ELSE
1931                ENDIF
1932
1933            CASE DEFAULT
1934                CONTINUE
1935
1936       END SELECT
1937
1938    ELSEIF ( mode == 'average' )  THEN
1939
1940       SELECT CASE ( TRIM( var ) )
1941
1942            CASE ( 'usm_wshf' )
1943!
1944!--             Array of sensible heat flux from surfaces (land, roof, wall)
1945                IF ( l == -1 )  THEN
1946                   DO  m = 1, surf_usm_h%ns
1947                      surf_usm_h%wshf_eb_av(m) = surf_usm_h%wshf_eb_av(m) /                        &
1948                                                 REAL( average_count_3d, kind=wp )
1949                   ENDDO
1950                ELSE
1951                   DO  m = 1, surf_usm_v(l)%ns
1952                      surf_usm_v(l)%wshf_eb_av(m) = surf_usm_v(l)%wshf_eb_av(m) /                  &
1953                                                    REAL( average_count_3d, kind=wp )
1954                   ENDDO
1955                ENDIF
1956
1957            CASE ( 'usm_qsws' )
1958!
1959!--             Array of latent heat flux from surfaces (land, roof, wall)
1960                IF ( l == -1 )  THEN
1961                DO  m = 1, surf_usm_h%ns
1962                   surf_usm_h%qsws_av(m) = surf_usm_h%qsws_av(m) /                                 &
1963                                           REAL( average_count_3d, kind=wp )
1964                ENDDO
1965                ELSE
1966                   DO  m = 1, surf_usm_v(l)%ns
1967                      surf_usm_v(l)%qsws_av(m) = surf_usm_v(l)%qsws_av(m) /                        &
1968                                                 REAL( average_count_3d, kind=wp )
1969                   ENDDO
1970                ENDIF
1971
1972            CASE ( 'usm_qsws_veg' )
1973!
1974!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
1975                IF ( l == -1 )  THEN
1976                DO  m = 1, surf_usm_h%ns
1977                   surf_usm_h%qsws_veg_av(m) = surf_usm_h%qsws_veg_av(m) /                         &
1978                                               REAL( average_count_3d, kind=wp )
1979                ENDDO
1980                ELSE
1981                   DO  m = 1, surf_usm_v(l)%ns
1982                      surf_usm_v(l)%qsws_veg_av(m) = surf_usm_v(l)%qsws_veg_av(m) /                &
1983                                                     REAL( average_count_3d, kind=wp )
1984                   ENDDO
1985                ENDIF
1986
1987            CASE ( 'usm_qsws_liq' )
1988!
1989!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
1990                IF ( l == -1 )  THEN
1991                DO  m = 1, surf_usm_h%ns
1992                   surf_usm_h%qsws_liq_av(m) = surf_usm_h%qsws_liq_av(m) /                         &
1993                                               REAL( average_count_3d, kind=wp )
1994                ENDDO
1995                ELSE
1996                   DO  m = 1, surf_usm_v(l)%ns
1997                      surf_usm_v(l)%qsws_liq_av(m) = surf_usm_v(l)%qsws_liq_av(m) /                &
1998                                                     REAL( average_count_3d, kind=wp )
1999                   ENDDO
2000                ENDIF
2001
2002            CASE ( 'usm_wghf' )
2003!
2004!--             Array of heat flux from ground (wall, roof, land)
2005                IF ( l == -1 )  THEN
2006                   DO  m = 1, surf_usm_h%ns
2007                      surf_usm_h%wghf_eb_av(m) = surf_usm_h%wghf_eb_av(m) /                        &
2008                                                 REAL( average_count_3d, kind=wp )
2009                   ENDDO
2010                ELSE
2011                   DO  m = 1, surf_usm_v(l)%ns
2012                      surf_usm_v(l)%wghf_eb_av(m) = surf_usm_v(l)%wghf_eb_av(m) /                  &
2013                                                    REAL( average_count_3d, kind=wp )
2014                   ENDDO
2015                ENDIF
2016
2017            CASE ( 'usm_wghf_window' )
2018!
2019!--             Array of heat flux from window ground (wall, roof, land)
2020                IF ( l == -1 )  THEN
2021                   DO  m = 1, surf_usm_h%ns
2022                      surf_usm_h%wghf_eb_window_av(m) = surf_usm_h%wghf_eb_window_av(m) /          &
2023                                                        REAL( average_count_3d, kind=wp )
2024                   ENDDO
2025                ELSE
2026                   DO  m = 1, surf_usm_v(l)%ns
2027                      surf_usm_v(l)%wghf_eb_window_av(m) = surf_usm_v(l)%wghf_eb_window_av(m) /    &
2028                                                           REAL( average_count_3d, kind=wp )
2029                   ENDDO
2030                ENDIF
2031
2032            CASE ( 'usm_wghf_green' )
2033!
2034!--             Array of heat flux from green ground (wall, roof, land)
2035                IF ( l == -1 )  THEN
2036                   DO  m = 1, surf_usm_h%ns
2037                      surf_usm_h%wghf_eb_green_av(m) = surf_usm_h%wghf_eb_green_av(m) /            &
2038                                                       REAL( average_count_3d, kind=wp )
2039                   ENDDO
2040                ELSE
2041                   DO  m = 1, surf_usm_v(l)%ns
2042                      surf_usm_v(l)%wghf_eb_green_av(m) = surf_usm_v(l)%wghf_eb_green_av(m) /      &
2043                                                          REAL( average_count_3d, kind=wp )
2044                   ENDDO
2045                ENDIF
2046
2047            CASE ( 'usm_iwghf' )
2048!
2049!--             Array of heat flux from indoor ground (wall, roof, land)
2050                IF ( l == -1 )  THEN
2051                   DO  m = 1, surf_usm_h%ns
2052                      surf_usm_h%iwghf_eb_av(m) = surf_usm_h%iwghf_eb_av(m) /                      &
2053                                                  REAL( average_count_3d, kind=wp )
2054                   ENDDO
2055                ELSE
2056                   DO  m = 1, surf_usm_v(l)%ns
2057                      surf_usm_v(l)%iwghf_eb_av(m) = surf_usm_v(l)%iwghf_eb_av(m) /                &
2058                                                     REAL( average_count_3d, kind=wp )
2059                   ENDDO
2060                ENDIF
2061
2062            CASE ( 'usm_iwghf_window' )
2063!
2064!--             Array of heat flux from indoor window ground (wall, roof, land)
2065                IF ( l == -1 )  THEN
2066                   DO  m = 1, surf_usm_h%ns
2067                      surf_usm_h%iwghf_eb_window_av(m) = surf_usm_h%iwghf_eb_window_av(m) /        &
2068                                                         REAL( average_count_3d, kind=wp )
2069                   ENDDO
2070                ELSE
2071                   DO  m = 1, surf_usm_v(l)%ns
2072                      surf_usm_v(l)%iwghf_eb_window_av(m) = surf_usm_v(l)%iwghf_eb_window_av(m) /  &
2073                                                            REAL( average_count_3d, kind=wp )
2074                   ENDDO
2075                ENDIF
2076
2077            CASE ( 'usm_t_surf_wall' )
2078!
2079!--             Surface temperature for surfaces
2080                IF ( l == -1 )  THEN
2081                   DO  m = 1, surf_usm_h%ns
2082                   surf_usm_h%t_surf_wall_av(m) = surf_usm_h%t_surf_wall_av(m) /                   &
2083                                                  REAL( average_count_3d, kind=wp )
2084                   ENDDO
2085                ELSE
2086                   DO  m = 1, surf_usm_v(l)%ns
2087                      surf_usm_v(l)%t_surf_wall_av(m) = surf_usm_v(l)%t_surf_wall_av(m) /          &
2088                                                        REAL( average_count_3d, kind=wp )
2089                   ENDDO
2090                ENDIF
2091
2092            CASE ( 'usm_t_surf_window' )
2093!
2094!--             Surface temperature for window surfaces
2095                IF ( l == -1 )  THEN
2096                   DO  m = 1, surf_usm_h%ns
2097                      surf_usm_h%t_surf_window_av(m) = surf_usm_h%t_surf_window_av(m) /            &
2098                                                       REAL( average_count_3d, kind=wp )
2099                   ENDDO
2100                ELSE
2101                   DO  m = 1, surf_usm_v(l)%ns
2102                      surf_usm_v(l)%t_surf_window_av(m) = surf_usm_v(l)%t_surf_window_av(m) /      &
2103                                                          REAL( average_count_3d, kind=wp )
2104                   ENDDO
2105                ENDIF
2106
2107            CASE ( 'usm_t_surf_green' )
2108!
2109!--             Surface temperature for green surfaces
2110                IF ( l == -1 )  THEN
2111                   DO  m = 1, surf_usm_h%ns
2112                      surf_usm_h%t_surf_green_av(m) = surf_usm_h%t_surf_green_av(m) /              &
2113                                                      REAL( average_count_3d, kind=wp )
2114                   ENDDO
2115                ELSE
2116                   DO  m = 1, surf_usm_v(l)%ns
2117                      surf_usm_v(l)%t_surf_green_av(m) = surf_usm_v(l)%t_surf_green_av(m) /        &
2118                                                         REAL( average_count_3d, kind=wp )
2119                   ENDDO
2120                ENDIF
2121
2122            CASE ( 'usm_theta_10cm' )
2123!
2124!--             Near surface temperature for whole surfaces
2125                IF ( l == -1 )  THEN
2126                   DO  m = 1, surf_usm_h%ns
2127                      surf_usm_h%pt_10cm_av(m) = surf_usm_h%pt_10cm_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)%pt_10cm_av(m) = surf_usm_v(l)%pt_10cm_av(m) /                  &
2133                                                    REAL( average_count_3d, kind=wp )
2134                   ENDDO
2135                ENDIF
2136
2137
2138            CASE ( 'usm_t_wall' )
2139!
2140!--             Wall temperature for  iwl layer of walls and land
2141                IF ( l == -1 )  THEN
2142                   DO  m = 1, surf_usm_h%ns
2143                      surf_usm_h%t_wall_av(iwl,m) = surf_usm_h%t_wall_av(iwl,m) /                  &
2144                                                    REAL( average_count_3d, kind=wp )
2145                   ENDDO
2146                ELSE
2147                   DO  m = 1, surf_usm_v(l)%ns
2148                      surf_usm_v(l)%t_wall_av(iwl,m) = surf_usm_v(l)%t_wall_av(iwl,m) /            &
2149                                                       REAL( average_count_3d, kind=wp )
2150                   ENDDO
2151                ENDIF
2152
2153            CASE ( 'usm_t_window' )
2154!
2155!--             Window temperature for  iwl layer of walls and land
2156                IF ( l == -1 )  THEN
2157                   DO  m = 1, surf_usm_h%ns
2158                      surf_usm_h%t_window_av(iwl,m) = surf_usm_h%t_window_av(iwl,m) /              &
2159                                                      REAL( average_count_3d, kind=wp )
2160                   ENDDO
2161                ELSE
2162                   DO  m = 1, surf_usm_v(l)%ns
2163                      surf_usm_v(l)%t_window_av(iwl,m) = surf_usm_v(l)%t_window_av(iwl,m) /        &
2164                                                         REAL( average_count_3d, kind=wp )
2165                   ENDDO
2166                ENDIF
2167
2168            CASE ( 'usm_t_green' )
2169!
2170!--             Green temperature for  iwl layer of walls and land
2171                IF ( l == -1 )  THEN
2172                   DO  m = 1, surf_usm_h%ns
2173                      surf_usm_h%t_green_av(iwl,m) = surf_usm_h%t_green_av(iwl,m) /                &
2174                                                     REAL( average_count_3d, kind=wp )
2175                   ENDDO
2176                ELSE
2177                   DO  m = 1, surf_usm_v(l)%ns
2178                      surf_usm_v(l)%t_green_av(iwl,m) = surf_usm_v(l)%t_green_av(iwl,m) /          &
2179                                                        REAL( average_count_3d, kind=wp )
2180                   ENDDO
2181                ENDIF
2182
2183            CASE ( 'usm_swc' )
2184!
2185!--             Soil water content for  iwl layer of walls and land
2186                IF ( l == -1 )  THEN
2187                DO  m = 1, surf_usm_h%ns
2188                   surf_usm_h%swc_av(iwl,m) = surf_usm_h%swc_av(iwl,m) /                           &
2189                                              REAL( average_count_3d, kind=wp )
2190                ENDDO
2191                ELSE
2192                   DO  m = 1, surf_usm_v(l)%ns
2193                      surf_usm_v(l)%swc_av(iwl,m) = surf_usm_v(l)%swc_av(iwl,m) /                  &
2194                                                    REAL( average_count_3d, kind=wp )
2195                   ENDDO
2196                ENDIF
2197
2198
2199       END SELECT
2200
2201    ENDIF
2202
2203    ENDIF
2204
2205 END SUBROUTINE usm_3d_data_averaging
2206
2207
2208
2209!--------------------------------------------------------------------------------------------------!
2210! Description:
2211! ------------
2212!> Set internal Neumann boundary condition at outer soil grid points for temperature and humidity.
2213!--------------------------------------------------------------------------------------------------!
2214 SUBROUTINE usm_boundary_condition
2215
2216    IMPLICIT NONE
2217
2218    INTEGER(iwp) ::  i      !< grid index x-direction
2219    INTEGER(iwp) ::  ioff   !< offset index x-direction indicating location of soil grid point
2220    INTEGER(iwp) ::  j      !< grid index y-direction
2221    INTEGER(iwp) ::  joff   !< offset index x-direction indicating location of soil grid point
2222    INTEGER(iwp) ::  k      !< grid index z-direction
2223    INTEGER(iwp) ::  koff   !< offset index x-direction indicating location of soil grid point
2224    INTEGER(iwp) ::  l      !< running index surface-orientation
2225    INTEGER(iwp) ::  m      !< running index surface elements
2226
2227    koff = surf_usm_h%koff
2228    DO  m = 1, surf_usm_h%ns
2229       i = surf_usm_h%i(m)
2230       j = surf_usm_h%j(m)
2231       k = surf_usm_h%k(m)
2232       pt(k+koff,j,i) = pt(k,j,i)
2233    ENDDO
2234
2235    DO  l = 0, 3
2236       ioff = surf_usm_v(l)%ioff
2237       joff = surf_usm_v(l)%joff
2238       DO  m = 1, surf_usm_v(l)%ns
2239          i = surf_usm_v(l)%i(m)
2240          j = surf_usm_v(l)%j(m)
2241          k = surf_usm_v(l)%k(m)
2242          pt(k,j+joff,i+ioff) = pt(k,j,i)
2243       ENDDO
2244    ENDDO
2245
2246 END SUBROUTINE usm_boundary_condition
2247
2248
2249!--------------------------------------------------------------------------------------------------!
2250!
2251! Description:
2252! ------------
2253!> Subroutine checks variables and assigns units.
2254!> It is called out from subroutine check_parameters.
2255!--------------------------------------------------------------------------------------------------!
2256 SUBROUTINE usm_check_data_output( variable, unit )
2257
2258    IMPLICIT NONE
2259
2260    CHARACTER(LEN=*),INTENT(IN)    ::  variable   !<
2261    CHARACTER(LEN=*),INTENT(OUT)   ::  unit       !<
2262
2263    CHARACTER(LEN=2)                              ::  ls            !<
2264
2265    CHARACTER(LEN=varnamelength)                  ::  var           !< TRIM(variable)
2266
2267    INTEGER(iwp)                                  ::  i,j,l         !< index
2268
2269    INTEGER(iwp), PARAMETER                       ::  nl1 = 15      !< number of directional usm variables
2270    CHARACTER(LEN=varnamelength), DIMENSION(nl1)  ::  varlist1 = &  !< list of directional usm variables
2271              (/'usm_wshf                      ', &
2272                'usm_wghf                      ', &
2273                'usm_wghf_window               ', &
2274                'usm_wghf_green                ', &
2275                'usm_iwghf                     ', &
2276                'usm_iwghf_window              ', &
2277                'usm_surfz                     ', &
2278                'usm_surfwintrans              ', &
2279                'usm_surfcat                   ', &
2280                'usm_t_surf_wall               ', &
2281                'usm_t_surf_window             ', &
2282                'usm_t_surf_green              ', &
2283                'usm_t_green                   ', &
2284                'usm_qsws                      ', &
2285                'usm_theta_10cm                '/)
2286
2287    INTEGER(iwp), PARAMETER                       ::  nl2 = 3       !< number of directional layer usm variables
2288    CHARACTER(LEN=varnamelength), DIMENSION(nl2)  ::  varlist2 = &  !< list of directional layer usm variables
2289              (/'usm_t_wall                    ', &
2290                'usm_t_window                  ', &
2291                'usm_t_green                   '/)
2292
2293    INTEGER(iwp), PARAMETER                       ::  nd = 5     !< number of directions
2294    CHARACTER(LEN=6), DIMENSION(nd), PARAMETER    ::  dirname = &  !< direction names
2295              (/'_roof ','_south','_north','_west ','_east '/)
2296
2297    LOGICAL                                       ::  lfound     !< flag if the variable is found
2298
2299
2300    lfound = .FALSE.
2301
2302    var = TRIM( variable )
2303
2304!
2305!-- Check if variable exists
2306!-- Directional variables
2307    DO  i = 1, nl1
2308       DO  j = 1, nd
2309          IF ( TRIM( var ) == TRIM( varlist1(i)) // TRIM( dirname(j) ) )  THEN
2310             lfound = .TRUE.
2311             EXIT
2312          ENDIF
2313          IF ( lfound )  EXIT
2314       ENDDO
2315    ENDDO
2316    IF ( lfound )  GOTO 10
2317!
2318!-- Directional layer variables
2319    DO  i = 1, nl2
2320       DO  j = 1, nd
2321          DO  l = nzb_wall, nzt_wall
2322             WRITE( ls,'(A1,I1)' ) '_', l
2323             IF ( TRIM( var ) == TRIM( varlist2(i) ) // TRIM( ls ) // TRIM( dirname(j) ) )  THEN
2324                lfound = .TRUE.
2325                EXIT
2326             ENDIF
2327          ENDDO
2328          IF ( lfound )  EXIT
2329       ENDDO
2330    ENDDO
2331    IF ( .NOT.  lfound )  THEN
2332       unit = 'illegal'
2333       RETURN
2334    ENDIF
233510  CONTINUE
2336
2337    IF ( var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' .OR.                              &
2338         var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR.                  &
2339         var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_'    .OR.                   &
2340         var(1:17) == 'usm_surfwintrans_' .OR.                                                     &
2341         var(1:9)  == 'usm_qsws_'  .OR.  var(1:13)  == 'usm_qsws_veg_'  .OR.                       &
2342         var(1:13) == 'usm_qsws_liq_' )  THEN
2343        unit = 'W/m2'
2344    ELSE IF ( var(1:15) == 'usm_t_surf_wall'   .OR.  var(1:10) == 'usm_t_wall' .OR.                &
2345              var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR.               &
2346              var(1:16) == 'usm_t_surf_green'  .OR.                                                &
2347              var(1:11) == 'usm_t_green' .OR.  var(1:7) == 'usm_swc' .OR.                          &
2348              var(1:14) == 'usm_theta_10cm' )  THEN
2349        unit = 'K'
2350    ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat' )  THEN
2351        unit = '1'
2352    ELSE
2353        unit = 'illegal'
2354    ENDIF
2355
2356 END SUBROUTINE usm_check_data_output
2357
2358
2359!--------------------------------------------------------------------------------------------------!
2360! Description:
2361! ------------
2362!> Check parameters routine for urban surface model
2363!--------------------------------------------------------------------------------------------------!
2364 SUBROUTINE usm_check_parameters
2365
2366    USE control_parameters,                                                                        &
2367        ONLY:  bc_pt_b,                                                                            &
2368               bc_q_b,                                                                             &
2369               constant_flux_layer,                                                                &
2370               large_scale_forcing,                                                                &
2371               lsf_surf,                                                                           &
2372               topography
2373
2374    USE netcdf_data_input_mod,                                                                     &
2375         ONLY:  building_type_f
2376
2377    IMPLICIT NONE
2378
2379    INTEGER(iwp) ::  i  !< running index, x-dimension
2380    INTEGER(iwp) ::  j  !< running index, y-dimension
2381
2382!
2383!-- Dirichlet boundary conditions are required as the surface fluxes are calculated from the
2384!-- temperature/humidity gradients in the urban surface model
2385    IF ( bc_pt_b == 'neumann'   .OR.   bc_q_b == 'neumann' )  THEN
2386       message_string = 'urban surface model requires setting of bc_pt_b = "dirichlet" and '//     &
2387                        'bc_q_b  = "dirichlet"'
2388       CALL message( 'usm_check_parameters', 'PA0590', 1, 2, 0, 6, 0 )
2389    ENDIF
2390
2391    IF ( .NOT.  constant_flux_layer )  THEN
2392       message_string = 'urban surface model requires constant_flux_layer = .TRUE.'
2393       CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2394    ENDIF
2395
2396    IF (  .NOT.  radiation )  THEN
2397       message_string = 'urban surface model requires the radiation model to be switched on'
2398       CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2399    ENDIF
2400!
2401!-- Surface forcing has to be disabled for LSF in case of enabled urban surface module
2402    IF ( large_scale_forcing )  THEN
2403       lsf_surf = .FALSE.
2404    ENDIF
2405!
2406!-- Topography
2407    IF ( topography == 'flat' )  THEN
2408       message_string = 'topography /= "flat" is required when using the urban surface model'
2409       CALL message( 'usm_check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
2410    ENDIF
2411!
2412!-- Naheatlayers
2413    IF ( naheatlayers > nzt )  THEN
2414       message_string = 'number of anthropogenic heat layers "naheatlayers" can not be larger ' // &
2415                        'than number of domain layers "nzt"'
2416       CALL message( 'usm_check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
2417    ENDIF
2418!
2419!-- Check if building types are set within a valid range.
2420    IF ( building_type < LBOUND( building_pars, 2 )  .AND.                                         &
2421         building_type > UBOUND( building_pars, 2 ) )  THEN
2422       WRITE( message_string, * ) 'building_type = ', building_type, ' is out of the valid range'
2423       CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
2424    ENDIF
2425    IF ( building_type_f%from_file )  THEN
2426       DO  i = nxl, nxr
2427          DO  j = nys, nyn
2428             IF ( building_type_f%var(j,i) /= building_type_f%fill  .AND.                          &
2429           ( building_type_f%var(j,i) < LBOUND( building_pars, 2 )  .OR.                           &
2430             building_type_f%var(j,i) > UBOUND( building_pars, 2 ) ) )  THEN
2431                WRITE( message_string, * ) 'building_type = is out of the valid range at (j,i) = ' &
2432                                           , j, i
2433                CALL message( 'usm_check_parameters', 'PA0529', 2, 2, myid, 6, 0 )
2434             ENDIF
2435          ENDDO
2436       ENDDO
2437    ENDIF
2438 END SUBROUTINE usm_check_parameters
2439
2440
2441!--------------------------------------------------------------------------------------------------!
2442!
2443! Description:
2444! ------------
2445!> Output of the 3D-arrays in netCDF and/or AVS format for variables of urban_surface model.
2446!> It resorts the urban surface module output quantities from surf style indexing into temporary 3D
2447!> array with indices (i,j,k). It is called from subroutine data_output_3d.
2448!--------------------------------------------------------------------------------------------------!
2449 SUBROUTINE usm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
2450
2451    IMPLICIT NONE
2452
2453    CHARACTER(LEN=*), INTENT(IN)   ::  variable  !< variable name
2454
2455    CHARACTER(LEN=varnamelength)   ::  var  !< trimmed variable name
2456
2457    INTEGER(iwp), INTENT(IN)       ::  av        !< flag if averaged
2458    INTEGER(iwp), INTENT(IN)       ::  nzb_do    !< lower limit of the data output (usually 0)
2459    INTEGER(iwp), INTENT(IN)       ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
2460
2461    INTEGER(iwp), PARAMETER                            ::  nd = 5  !< number of directions
2462    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         ::  dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)  !<
2463    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         ::  diridx =  (/       -1,        1,        0,        3,        2 /)
2464                                                           !< index for surf_*_v: 0:3 = (North, South, East, West)
2465    CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER     ::  dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)  !<
2466
2467
2468    INTEGER(iwp)  ::  ids, idsint, idsidx        !<
2469    INTEGER(iwp)  ::  i, j, k, iwl, istat, l, m  !< running indices
2470
2471    LOGICAL, INTENT(OUT)           ::  found     !<
2472
2473    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< sp - it has to correspond to module data_output_3d
2474    REAL(sp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf   !< temp array for urban surface output procedure
2475
2476    found = .TRUE.
2477    temp_pf = -1._wp
2478
2479    ids = -1
2480    var = TRIM( variable )
2481    DO i = 0, nd-1
2482        k = len( TRIM( var ) )
2483        j = len( TRIM( dirname(i) ) )
2484        IF ( TRIM( var(k-j+1:k) ) == TRIM( dirname(i) ) )  THEN
2485            ids = i
2486            idsint = dirint(ids)
2487            idsidx = diridx(ids)
2488            var = var(:k-j)
2489            EXIT
2490        ENDIF
2491    ENDDO
2492    IF ( ids == -1 )  THEN
2493        var = TRIM( variable )
2494    ENDIF
2495    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
2496!
2497!--     Wall layers
2498        READ( var(12:12), '(I1)', iostat = istat ) iwl
2499        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2500            var = var(1:10)
2501        ENDIF
2502    ENDIF
2503    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM( var ) ) >= 14 )  THEN
2504!
2505!--     Window layers
2506        READ( var(14:14), '(I1)', iostat = istat ) iwl
2507        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2508            var = var(1:12)
2509        ENDIF
2510    ENDIF
2511    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
2512!
2513!--     Green layers
2514        READ( var(13:13), '(I1)', iostat = istat ) iwl
2515        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2516            var = var(1:11)
2517        ENDIF
2518    ENDIF
2519    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
2520!
2521!--     Green layers soil water content
2522        READ( var(9:9), '(I1)', iostat = istat ) iwl
2523        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2524            var = var(1:7)
2525        ENDIF
2526    ENDIF
2527
2528    SELECT CASE ( TRIM( var ) )
2529
2530      CASE ( 'usm_surfz' )
2531!
2532!--       Array of surface height (z)
2533          IF ( idsint == iup_u )  THEN
2534             DO  m = 1, surf_usm_h%ns
2535                i = surf_usm_h%i(m)
2536                j = surf_usm_h%j(m)
2537                k = surf_usm_h%k(m)
2538                temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) )
2539             ENDDO
2540          ELSE
2541             l = idsidx
2542             DO  m = 1, surf_usm_v(l)%ns
2543                i = surf_usm_v(l)%i(m)
2544                j = surf_usm_v(l)%j(m)
2545                k = surf_usm_v(l)%k(m)
2546                temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) + 1.0_sp )
2547             ENDDO
2548          ENDIF
2549
2550      CASE ( 'usm_surfcat' )
2551!
2552!--       Surface category
2553          IF ( idsint == iup_u )  THEN
2554             DO  m = 1, surf_usm_h%ns
2555                i = surf_usm_h%i(m)
2556                j = surf_usm_h%j(m)
2557                k = surf_usm_h%k(m)
2558                temp_pf(k,j,i) = surf_usm_h%surface_types(m)
2559             ENDDO
2560          ELSE
2561             l = idsidx
2562             DO  m = 1, surf_usm_v(l)%ns
2563                i = surf_usm_v(l)%i(m)
2564                j = surf_usm_v(l)%j(m)
2565                k = surf_usm_v(l)%k(m)
2566                temp_pf(k,j,i) = surf_usm_v(l)%surface_types(m)
2567             ENDDO
2568          ENDIF
2569
2570      CASE ( 'usm_surfwintrans' )
2571!
2572!--       Transmissivity window tiles
2573          IF ( idsint == iup_u )  THEN
2574             DO  m = 1, surf_usm_h%ns
2575                i = surf_usm_h%i(m)
2576                j = surf_usm_h%j(m)
2577                k = surf_usm_h%k(m)
2578                temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
2579             ENDDO
2580          ELSE
2581             l = idsidx
2582             DO  m = 1, surf_usm_v(l)%ns
2583                i = surf_usm_v(l)%i(m)
2584                j = surf_usm_v(l)%j(m)
2585                k = surf_usm_v(l)%k(m)
2586                temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
2587             ENDDO
2588          ENDIF
2589
2590      CASE ( 'usm_wshf' )
2591!
2592!--       Array of sensible heat flux from surfaces
2593          IF ( av == 0 )  THEN
2594             IF ( idsint == iup_u )  THEN
2595                DO  m = 1, surf_usm_h%ns
2596                   i = surf_usm_h%i(m)
2597                   j = surf_usm_h%j(m)
2598                   k = surf_usm_h%k(m)
2599                   temp_pf(k,j,i) = surf_usm_h%wshf_eb(m)
2600                ENDDO
2601             ELSE
2602                l = idsidx
2603                DO  m = 1, surf_usm_v(l)%ns
2604                   i = surf_usm_v(l)%i(m)
2605                   j = surf_usm_v(l)%j(m)
2606                   k = surf_usm_v(l)%k(m)
2607                   temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb(m)
2608                ENDDO
2609             ENDIF
2610          ELSE
2611             IF ( idsint == iup_u )  THEN
2612                DO  m = 1, surf_usm_h%ns
2613                   i = surf_usm_h%i(m)
2614                   j = surf_usm_h%j(m)
2615                   k = surf_usm_h%k(m)
2616                   temp_pf(k,j,i) = surf_usm_h%wshf_eb_av(m)
2617                ENDDO
2618             ELSE
2619                l = idsidx
2620                DO  m = 1, surf_usm_v(l)%ns
2621                   i = surf_usm_v(l)%i(m)
2622                   j = surf_usm_v(l)%j(m)
2623                   k = surf_usm_v(l)%k(m)
2624                   temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb_av(m)
2625                ENDDO
2626             ENDIF
2627          ENDIF
2628
2629
2630      CASE ( 'usm_qsws' )
2631!
2632!--       Array of latent heat flux from surfaces
2633          IF ( av == 0 )  THEN
2634             IF ( idsint == iup_u )  THEN
2635                DO  m = 1, surf_usm_h%ns
2636                   i = surf_usm_h%i(m)
2637                   j = surf_usm_h%j(m)
2638                   k = surf_usm_h%k(m)
2639                   temp_pf(k,j,i) = surf_usm_h%qsws(m) * l_v
2640                ENDDO
2641             ELSE
2642                l = idsidx
2643                DO  m = 1, surf_usm_v(l)%ns
2644                   i = surf_usm_v(l)%i(m)
2645                   j = surf_usm_v(l)%j(m)
2646                   k = surf_usm_v(l)%k(m)
2647                   temp_pf(k,j,i) = surf_usm_v(l)%qsws(m) * l_v
2648                ENDDO
2649             ENDIF
2650          ELSE
2651             IF ( idsint == iup_u )  THEN
2652                DO  m = 1, surf_usm_h%ns
2653                   i = surf_usm_h%i(m)
2654                   j = surf_usm_h%j(m)
2655                   k = surf_usm_h%k(m)
2656                   temp_pf(k,j,i) = surf_usm_h%qsws_av(m)
2657                ENDDO
2658             ELSE
2659                l = idsidx
2660                DO  m = 1, surf_usm_v(l)%ns
2661                   i = surf_usm_v(l)%i(m)
2662                   j = surf_usm_v(l)%j(m)
2663                   k = surf_usm_v(l)%k(m)
2664                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_av(m)
2665                ENDDO
2666             ENDIF
2667          ENDIF
2668
2669      CASE ( 'usm_qsws_veg' )
2670!
2671!--       Array of latent heat flux from vegetation surfaces
2672          IF ( av == 0 )  THEN
2673             IF ( idsint == iup_u )  THEN
2674                DO  m = 1, surf_usm_h%ns
2675                   i = surf_usm_h%i(m)
2676                   j = surf_usm_h%j(m)
2677                   k = surf_usm_h%k(m)
2678                   temp_pf(k,j,i) = surf_usm_h%qsws_veg(m)
2679                ENDDO
2680             ELSE
2681                l = idsidx
2682                DO  m = 1, surf_usm_v(l)%ns
2683                   i = surf_usm_v(l)%i(m)
2684                   j = surf_usm_v(l)%j(m)
2685                   k = surf_usm_v(l)%k(m)
2686                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg(m)
2687                ENDDO
2688             ENDIF
2689          ELSE
2690             IF ( idsint == iup_u )  THEN
2691                DO  m = 1, surf_usm_h%ns
2692                   i = surf_usm_h%i(m)
2693                   j = surf_usm_h%j(m)
2694                   k = surf_usm_h%k(m)
2695                   temp_pf(k,j,i) = surf_usm_h%qsws_veg_av(m)
2696                ENDDO
2697             ELSE
2698                l = idsidx
2699                DO  m = 1, surf_usm_v(l)%ns
2700                   i = surf_usm_v(l)%i(m)
2701                   j = surf_usm_v(l)%j(m)
2702                   k = surf_usm_v(l)%k(m)
2703                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_av(m)
2704                ENDDO
2705             ENDIF
2706          ENDIF
2707
2708      CASE ( 'usm_qsws_liq' )
2709!
2710!--       Array of latent heat flux from surfaces with liquid
2711          IF ( av == 0 )  THEN
2712             IF ( idsint == iup_u )  THEN
2713                DO  m = 1, surf_usm_h%ns
2714                   i = surf_usm_h%i(m)
2715                   j = surf_usm_h%j(m)
2716                   k = surf_usm_h%k(m)
2717                   temp_pf(k,j,i) = surf_usm_h%qsws_liq(m)
2718                ENDDO
2719             ELSE
2720                l = idsidx
2721                DO  m = 1, surf_usm_v(l)%ns
2722                   i = surf_usm_v(l)%i(m)
2723                   j = surf_usm_v(l)%j(m)
2724                   k = surf_usm_v(l)%k(m)
2725                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq(m)
2726                ENDDO
2727             ENDIF
2728          ELSE
2729             IF ( idsint == iup_u )  THEN
2730                DO  m = 1, surf_usm_h%ns
2731                   i = surf_usm_h%i(m)
2732                   j = surf_usm_h%j(m)
2733                   k = surf_usm_h%k(m)
2734                   temp_pf(k,j,i) = surf_usm_h%qsws_liq_av(m)
2735                ENDDO
2736             ELSE
2737                l = idsidx
2738                DO  m = 1, surf_usm_v(l)%ns
2739                   i = surf_usm_v(l)%i(m)
2740                   j = surf_usm_v(l)%j(m)
2741                   k = surf_usm_v(l)%k(m)
2742                   temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_av(m)
2743                ENDDO
2744             ENDIF
2745          ENDIF
2746
2747      CASE ( 'usm_wghf' )
2748!
2749!--       Array of heat flux from ground (land, wall, roof)
2750          IF ( av == 0 )  THEN
2751             IF ( idsint == iup_u )  THEN
2752                DO  m = 1, surf_usm_h%ns
2753                   i = surf_usm_h%i(m)
2754                   j = surf_usm_h%j(m)
2755                   k = surf_usm_h%k(m)
2756                   temp_pf(k,j,i) = surf_usm_h%wghf_eb(m)
2757                ENDDO
2758             ELSE
2759                l = idsidx
2760                DO  m = 1, surf_usm_v(l)%ns
2761                   i = surf_usm_v(l)%i(m)
2762                   j = surf_usm_v(l)%j(m)
2763                   k = surf_usm_v(l)%k(m)
2764                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb(m)
2765                ENDDO
2766             ENDIF
2767          ELSE
2768             IF ( idsint == iup_u )  THEN
2769                DO  m = 1, surf_usm_h%ns
2770                   i = surf_usm_h%i(m)
2771                   j = surf_usm_h%j(m)
2772                   k = surf_usm_h%k(m)
2773                   temp_pf(k,j,i) = surf_usm_h%wghf_eb_av(m)
2774                ENDDO
2775             ELSE
2776                l = idsidx
2777                DO  m = 1, surf_usm_v(l)%ns
2778                   i = surf_usm_v(l)%i(m)
2779                   j = surf_usm_v(l)%j(m)
2780                   k = surf_usm_v(l)%k(m)
2781                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_av(m)
2782                ENDDO
2783             ENDIF
2784          ENDIF
2785
2786      CASE ( 'usm_wghf_window' )
2787!
2788!--       Array of heat flux from window ground (land, wall, roof)
2789          IF ( av == 0 )  THEN
2790             IF ( idsint == iup_u )  THEN
2791                DO  m = 1, surf_usm_h%ns
2792                   i = surf_usm_h%i(m)
2793                   j = surf_usm_h%j(m)
2794                   k = surf_usm_h%k(m)
2795                   temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
2796                ENDDO
2797             ELSE
2798                l = idsidx
2799                DO  m = 1, surf_usm_v(l)%ns
2800                   i = surf_usm_v(l)%i(m)
2801                   j = surf_usm_v(l)%j(m)
2802                   k = surf_usm_v(l)%k(m)
2803                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
2804                ENDDO
2805             ENDIF
2806          ELSE
2807             IF ( idsint == iup_u )  THEN
2808                DO  m = 1, surf_usm_h%ns
2809                   i = surf_usm_h%i(m)
2810                   j = surf_usm_h%j(m)
2811                   k = surf_usm_h%k(m)
2812                   temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
2813                ENDDO
2814             ELSE
2815                l = idsidx
2816                DO  m = 1, surf_usm_v(l)%ns
2817                   i = surf_usm_v(l)%i(m)
2818                   j = surf_usm_v(l)%j(m)
2819                   k = surf_usm_v(l)%k(m)
2820                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
2821                ENDDO
2822             ENDIF
2823          ENDIF
2824
2825      CASE ( 'usm_wghf_green' )
2826!
2827!--       Array of heat flux from green ground (land, wall, roof)
2828          IF ( av == 0 )  THEN
2829             IF ( idsint == iup_u )  THEN
2830                DO  m = 1, surf_usm_h%ns
2831                   i = surf_usm_h%i(m)
2832                   j = surf_usm_h%j(m)
2833                   k = surf_usm_h%k(m)
2834                   temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
2835                ENDDO
2836             ELSE
2837                l = idsidx
2838                DO  m = 1, surf_usm_v(l)%ns
2839                   i = surf_usm_v(l)%i(m)
2840                   j = surf_usm_v(l)%j(m)
2841                   k = surf_usm_v(l)%k(m)
2842                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
2843                ENDDO
2844             ENDIF
2845          ELSE
2846             IF ( idsint == iup_u )  THEN
2847                DO  m = 1, surf_usm_h%ns
2848                   i = surf_usm_h%i(m)
2849                   j = surf_usm_h%j(m)
2850                   k = surf_usm_h%k(m)
2851                   temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
2852                ENDDO
2853             ELSE
2854                l = idsidx
2855                DO  m = 1, surf_usm_v(l)%ns
2856                   i = surf_usm_v(l)%i(m)
2857                   j = surf_usm_v(l)%j(m)
2858                   k = surf_usm_v(l)%k(m)
2859                   temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
2860                ENDDO
2861             ENDIF
2862          ENDIF
2863
2864      CASE ( 'usm_iwghf' )
2865!
2866!--       Array of heat flux from indoor ground (land, wall, roof)
2867          IF ( av == 0 )  THEN
2868             IF ( idsint == iup_u )  THEN
2869                DO  m = 1, surf_usm_h%ns
2870                   i = surf_usm_h%i(m)
2871                   j = surf_usm_h%j(m)
2872                   k = surf_usm_h%k(m)
2873                   temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
2874                ENDDO
2875             ELSE
2876                l = idsidx
2877                DO  m = 1, surf_usm_v(l)%ns
2878                   i = surf_usm_v(l)%i(m)
2879                   j = surf_usm_v(l)%j(m)
2880                   k = surf_usm_v(l)%k(m)
2881                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
2882                ENDDO
2883             ENDIF
2884          ELSE
2885             IF ( idsint == iup_u )  THEN
2886                DO  m = 1, surf_usm_h%ns
2887                   i = surf_usm_h%i(m)
2888                   j = surf_usm_h%j(m)
2889                   k = surf_usm_h%k(m)
2890                   temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
2891                ENDDO
2892             ELSE
2893                l = idsidx
2894                DO  m = 1, surf_usm_v(l)%ns
2895                   i = surf_usm_v(l)%i(m)
2896                   j = surf_usm_v(l)%j(m)
2897                   k = surf_usm_v(l)%k(m)
2898                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
2899                ENDDO
2900             ENDIF
2901          ENDIF
2902
2903      CASE ( 'usm_iwghf_window' )
2904!
2905!--       Array of heat flux from indoor window ground (land, wall, roof)
2906          IF ( av == 0 )  THEN
2907             IF ( idsint == iup_u )  THEN
2908                DO  m = 1, surf_usm_h%ns
2909                   i = surf_usm_h%i(m)
2910                   j = surf_usm_h%j(m)
2911                   k = surf_usm_h%k(m)
2912                   temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(m)
2913                ENDDO
2914             ELSE
2915                l = idsidx
2916                DO  m = 1, surf_usm_v(l)%ns
2917                   i = surf_usm_v(l)%i(m)
2918                   j = surf_usm_v(l)%j(m)
2919                   k = surf_usm_v(l)%k(m)
2920                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
2921                ENDDO
2922             ENDIF
2923          ELSE
2924             IF ( idsint == iup_u )  THEN
2925                DO  m = 1, surf_usm_h%ns
2926                   i = surf_usm_h%i(m)
2927                   j = surf_usm_h%j(m)
2928                   k = surf_usm_h%k(m)
2929                   temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
2930                ENDDO
2931             ELSE
2932                l = idsidx
2933                DO  m = 1, surf_usm_v(l)%ns
2934                   i = surf_usm_v(l)%i(m)
2935                   j = surf_usm_v(l)%j(m)
2936                   k = surf_usm_v(l)%k(m)
2937                   temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
2938                ENDDO
2939             ENDIF
2940          ENDIF
2941
2942      CASE ( 'usm_t_surf_wall' )
2943!
2944!--       Surface temperature for surfaces
2945          IF ( av == 0 )  THEN
2946             IF ( idsint == iup_u )  THEN
2947                DO  m = 1, surf_usm_h%ns
2948                   i = surf_usm_h%i(m)
2949                   j = surf_usm_h%j(m)
2950                   k = surf_usm_h%k(m)
2951                   temp_pf(k,j,i) = t_surf_wall_h(m)
2952                ENDDO
2953             ELSE
2954                l = idsidx
2955                DO  m = 1, surf_usm_v(l)%ns
2956                   i = surf_usm_v(l)%i(m)
2957                   j = surf_usm_v(l)%j(m)
2958                   k = surf_usm_v(l)%k(m)
2959                   temp_pf(k,j,i) = t_surf_wall_v(l)%t(m)
2960                ENDDO
2961             ENDIF
2962          ELSE
2963             IF ( idsint == iup_u )  THEN
2964                DO  m = 1, surf_usm_h%ns
2965                   i = surf_usm_h%i(m)
2966                   j = surf_usm_h%j(m)
2967                   k = surf_usm_h%k(m)
2968                   temp_pf(k,j,i) = surf_usm_h%t_surf_wall_av(m)
2969                ENDDO
2970             ELSE
2971                l = idsidx
2972                DO  m = 1, surf_usm_v(l)%ns
2973                   i = surf_usm_v(l)%i(m)
2974                   j = surf_usm_v(l)%j(m)
2975                   k = surf_usm_v(l)%k(m)
2976                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_wall_av(m)
2977                ENDDO
2978             ENDIF
2979          ENDIF
2980
2981      CASE ( 'usm_t_surf_window' )
2982!
2983!--       Surface temperature for window surfaces
2984          IF ( av == 0 )  THEN
2985             IF ( idsint == iup_u )  THEN
2986                DO  m = 1, surf_usm_h%ns
2987                   i = surf_usm_h%i(m)
2988                   j = surf_usm_h%j(m)
2989                   k = surf_usm_h%k(m)
2990                   temp_pf(k,j,i) = t_surf_window_h(m)
2991                ENDDO
2992             ELSE
2993                l = idsidx
2994                DO  m = 1, surf_usm_v(l)%ns
2995                   i = surf_usm_v(l)%i(m)
2996                   j = surf_usm_v(l)%j(m)
2997                   k = surf_usm_v(l)%k(m)
2998                   temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
2999                ENDDO
3000             ENDIF
3001
3002          ELSE
3003             IF ( idsint == iup_u )  THEN
3004                DO  m = 1, surf_usm_h%ns
3005                   i = surf_usm_h%i(m)
3006                   j = surf_usm_h%j(m)
3007                   k = surf_usm_h%k(m)
3008                   temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
3009                ENDDO
3010             ELSE
3011                l = idsidx
3012                DO  m = 1, surf_usm_v(l)%ns
3013                   i = surf_usm_v(l)%i(m)
3014                   j = surf_usm_v(l)%j(m)
3015                   k = surf_usm_v(l)%k(m)
3016                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
3017                ENDDO
3018
3019             ENDIF
3020
3021          ENDIF
3022
3023      CASE ( 'usm_t_surf_green' )
3024!
3025!--       Surface temperature for green surfaces
3026          IF ( av == 0 )  THEN
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) = t_surf_green_h(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) = t_surf_green_v(l)%t(m)
3041                ENDDO
3042             ENDIF
3043
3044          ELSE
3045             IF ( idsint == iup_u )  THEN
3046                DO  m = 1, surf_usm_h%ns
3047                   i = surf_usm_h%i(m)
3048                   j = surf_usm_h%j(m)
3049                   k = surf_usm_h%k(m)
3050                   temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
3051                ENDDO
3052             ELSE
3053                l = idsidx
3054                DO  m = 1, surf_usm_v(l)%ns
3055                   i = surf_usm_v(l)%i(m)
3056                   j = surf_usm_v(l)%j(m)
3057                   k = surf_usm_v(l)%k(m)
3058                   temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
3059                ENDDO
3060
3061             ENDIF
3062
3063          ENDIF
3064
3065      CASE ( 'usm_theta_10cm' )
3066!
3067!--       Near surface temperature for whole surfaces
3068          IF ( av == 0 )  THEN
3069             IF ( idsint == iup_u )  THEN
3070                DO  m = 1, surf_usm_h%ns
3071                   i = surf_usm_h%i(m)
3072                   j = surf_usm_h%j(m)
3073                   k = surf_usm_h%k(m)
3074                   temp_pf(k,j,i) = surf_usm_h%pt_10cm(m)
3075                ENDDO
3076             ELSE
3077                l = idsidx
3078                DO  m = 1, surf_usm_v(l)%ns
3079                   i = surf_usm_v(l)%i(m)
3080                   j = surf_usm_v(l)%j(m)
3081                   k = surf_usm_v(l)%k(m)
3082                   temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm(m)
3083                ENDDO
3084             ENDIF
3085
3086
3087          ELSE
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) = surf_usm_h%pt_10cm_av(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) = surf_usm_v(l)%pt_10cm_av(m)
3102                ENDDO
3103
3104              ENDIF
3105          ENDIF
3106
3107      CASE ( 'usm_t_wall' )
3108!
3109!--       Wall temperature for  iwl layer of walls and land
3110          IF ( av == 0 )  THEN
3111             IF ( idsint == iup_u )  THEN
3112                DO  m = 1, surf_usm_h%ns
3113                   i = surf_usm_h%i(m)
3114                   j = surf_usm_h%j(m)
3115                   k = surf_usm_h%k(m)
3116                   temp_pf(k,j,i) = t_wall_h(iwl,m)
3117                ENDDO
3118             ELSE
3119                l = idsidx
3120                DO  m = 1, surf_usm_v(l)%ns
3121                   i = surf_usm_v(l)%i(m)
3122                   j = surf_usm_v(l)%j(m)
3123                   k = surf_usm_v(l)%k(m)
3124                   temp_pf(k,j,i) = t_wall_v(l)%t(iwl,m)
3125                ENDDO
3126             ENDIF
3127          ELSE
3128             IF ( idsint == iup_u )  THEN
3129                DO  m = 1, surf_usm_h%ns
3130                   i = surf_usm_h%i(m)
3131                   j = surf_usm_h%j(m)
3132                   k = surf_usm_h%k(m)
3133                   temp_pf(k,j,i) = surf_usm_h%t_wall_av(iwl,m)
3134                ENDDO
3135             ELSE
3136                l = idsidx
3137                DO  m = 1, surf_usm_v(l)%ns
3138                   i = surf_usm_v(l)%i(m)
3139                   j = surf_usm_v(l)%j(m)
3140                   k = surf_usm_v(l)%k(m)
3141                   temp_pf(k,j,i) = surf_usm_v(l)%t_wall_av(iwl,m)
3142                ENDDO
3143             ENDIF
3144          ENDIF
3145
3146      CASE ( 'usm_t_window' )
3147!
3148!--       Window temperature for iwl layer of walls and land
3149          IF ( av == 0 )  THEN
3150             IF ( idsint == iup_u )  THEN
3151                DO  m = 1, surf_usm_h%ns
3152                   i = surf_usm_h%i(m)
3153                   j = surf_usm_h%j(m)
3154                   k = surf_usm_h%k(m)
3155                   temp_pf(k,j,i) = t_window_h(iwl,m)
3156                ENDDO
3157             ELSE
3158                l = idsidx
3159                DO  m = 1, surf_usm_v(l)%ns
3160                   i = surf_usm_v(l)%i(m)
3161                   j = surf_usm_v(l)%j(m)
3162                   k = surf_usm_v(l)%k(m)
3163                   temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
3164                ENDDO
3165             ENDIF
3166          ELSE
3167             IF ( idsint == iup_u )  THEN
3168                DO  m = 1, surf_usm_h%ns
3169                   i = surf_usm_h%i(m)
3170                   j = surf_usm_h%j(m)
3171                   k = surf_usm_h%k(m)
3172                   temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
3173                ENDDO
3174             ELSE
3175                l = idsidx
3176                DO  m = 1, surf_usm_v(l)%ns
3177                   i = surf_usm_v(l)%i(m)
3178                   j = surf_usm_v(l)%j(m)
3179                   k = surf_usm_v(l)%k(m)
3180                   temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
3181                ENDDO
3182             ENDIF
3183          ENDIF
3184
3185      CASE ( 'usm_t_green' )
3186!
3187!--       Green temperature for  iwl layer of walls and land
3188          IF ( av == 0 )  THEN
3189             IF ( idsint == iup_u )  THEN
3190                DO  m = 1, surf_usm_h%ns
3191                   i = surf_usm_h%i(m)
3192                   j = surf_usm_h%j(m)
3193                   k = surf_usm_h%k(m)
3194                   temp_pf(k,j,i) = t_green_h(iwl,m)
3195                ENDDO
3196             ELSE
3197                l = idsidx
3198                DO  m = 1, surf_usm_v(l)%ns
3199                   i = surf_usm_v(l)%i(m)
3200                   j = surf_usm_v(l)%j(m)
3201                   k = surf_usm_v(l)%k(m)
3202                   temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
3203                ENDDO
3204             ENDIF
3205          ELSE
3206             IF ( idsint == iup_u )  THEN
3207                DO  m = 1, surf_usm_h%ns
3208                   i = surf_usm_h%i(m)
3209                   j = surf_usm_h%j(m)
3210                   k = surf_usm_h%k(m)
3211                   temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
3212                ENDDO
3213             ELSE
3214                l = idsidx
3215                DO  m = 1, surf_usm_v(l)%ns
3216                   i = surf_usm_v(l)%i(m)
3217                   j = surf_usm_v(l)%j(m)
3218                   k = surf_usm_v(l)%k(m)
3219                   temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
3220                ENDDO
3221             ENDIF
3222          ENDIF
3223
3224          CASE ( 'usm_swc' )
3225!
3226!--       Soil water content for  iwl layer of walls and land
3227          IF ( av == 0 )  THEN
3228             IF ( idsint == iup_u )  THEN
3229                DO  m = 1, surf_usm_h%ns
3230                   i = surf_usm_h%i(m)
3231                   j = surf_usm_h%j(m)
3232                   k = surf_usm_h%k(m)
3233                   temp_pf(k,j,i) = swc_h(iwl,m)
3234                ENDDO
3235             ELSE
3236
3237             ENDIF
3238          ELSE
3239             IF ( idsint == iup_u )  THEN
3240                DO  m = 1, surf_usm_h%ns
3241                   i = surf_usm_h%i(m)
3242                   j = surf_usm_h%j(m)
3243                   k = surf_usm_h%k(m)
3244                   temp_pf(k,j,i) = surf_usm_h%swc_av(iwl,m)
3245                ENDDO
3246             ELSE
3247                l = idsidx
3248                DO  m = 1, surf_usm_v(l)%ns
3249                   i = surf_usm_v(l)%i(m)
3250                   j = surf_usm_v(l)%j(m)
3251                   k = surf_usm_v(l)%k(m)
3252                   temp_pf(k,j,i) = surf_usm_v(l)%swc_av(iwl,m)
3253                ENDDO
3254             ENDIF
3255          ENDIF
3256
3257
3258      CASE DEFAULT
3259          found = .FALSE.
3260          RETURN
3261    END SELECT
3262
3263!
3264!-- Rearrange dimensions for NetCDF output
3265!-- FIXME: this may generate FPE overflow upon conversion from DP to SP
3266    DO  j = nys, nyn
3267        DO  i = nxl, nxr
3268            DO  k = nzb_do, nzt_do
3269                local_pf(i,j,k) = temp_pf(k,j,i)
3270            ENDDO
3271        ENDDO
3272    ENDDO
3273
3274 END SUBROUTINE usm_data_output_3d
3275
3276
3277!--------------------------------------------------------------------------------------------------!
3278!
3279! Description:
3280! ------------
3281!> Soubroutine defines appropriate grid for netcdf variables.
3282!> It is called out from subroutine netcdf.
3283!--------------------------------------------------------------------------------------------------!
3284 SUBROUTINE usm_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
3285
3286    IMPLICIT NONE
3287
3288    CHARACTER(LEN=*), INTENT(IN)  ::  variable  !<
3289    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x    !<
3290    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y    !<
3291    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z    !<
3292
3293    CHARACTER(LEN=varnamelength)  ::  var  !<
3294
3295    LOGICAL, INTENT(OUT)  ::  found  !<
3296
3297    var = TRIM( variable )
3298    IF ( var(1:9) == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_'  .OR.                              &
3299         var(1:16) == 'usm_wghf_window_'  .OR. var(1:15) == 'usm_wghf_green_' .OR.                 &
3300         var(1:10) == 'usm_iwghf_'  .OR. var(1:17) == 'usm_iwghf_window_' .OR.                     &
3301         var(1:9) == 'usm_qsws_'  .OR.  var(1:13) == 'usm_qsws_veg_'  .OR.                         &
3302         var(1:13) == 'usm_qsws_liq_' .OR.                                                         &
3303         var(1:15) == 'usm_t_surf_wall'  .OR.  var(1:10) == 'usm_t_wall'  .OR.                     &
3304         var(1:17) == 'usm_t_surf_window'  .OR.  var(1:12) == 'usm_t_window'  .OR.                 &
3305         var(1:16) == 'usm_t_surf_green'  .OR. var(1:11) == 'usm_t_green' .OR.                     &
3306         var(1:15) == 'usm_theta_10cm' .OR.                                                        &
3307         var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                           &
3308         var(1:16) == 'usm_surfwintrans'  .OR. var(1:7) == 'usm_swc' ) THEN
3309
3310        found = .TRUE.
3311        grid_x = 'x'
3312        grid_y = 'y'
3313        grid_z = 'zu'
3314    ELSE
3315        found  = .FALSE.
3316        grid_x = 'none'
3317        grid_y = 'none'
3318        grid_z = 'none'
3319    ENDIF
3320
3321 END SUBROUTINE usm_define_netcdf_grid
3322
3323
3324!--------------------------------------------------------------------------------------------------!
3325! Description:
3326! ------------
3327!> Initialization of the wall surface model
3328!--------------------------------------------------------------------------------------------------!
3329 SUBROUTINE usm_init_material_model
3330
3331    IMPLICIT NONE
3332
3333    INTEGER(iwp) ::  k, l, m  !< running indices
3334
3335    IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'start' )
3336
3337!
3338!-- Calculate wall and window grid spacings. Wall temperature is defined at the center of the
3339!-- wall layers.
3340!-- First for horizontal surfaces:
3341    DO  m = 1, surf_usm_h%ns
3342
3343       surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
3344       DO k = nzb_wall+1, nzt_wall
3345          surf_usm_h%dz_wall(k,m) = surf_usm_h%zw(k,m) - surf_usm_h%zw(k-1,m)
3346       ENDDO
3347       surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
3348       DO  k = nzb_wall+1, nzt_wall
3349          surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) - surf_usm_h%zw_window(k-1,m)
3350       ENDDO
3351
3352       surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
3353
3354       DO k = nzb_wall, nzt_wall-1
3355         surf_usm_h%dz_wall_stag(k,m) = 0.5 * ( surf_usm_h%dz_wall(k+1,m) +                        &
3356                                                  surf_usm_h%dz_wall(k,m) )
3357       ENDDO
3358       surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
3359
3360       surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
3361
3362       DO  k = nzb_wall, nzt_wall-1
3363          surf_usm_h%dz_window_stag(k,m) = 0.5 * ( surf_usm_h%dz_window(k+1,m) +                   &
3364                                                   surf_usm_h%dz_window(k,m) )
3365       ENDDO
3366       surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
3367
3368       IF (surf_usm_h%green_type_roof(m) == 2.0_wp )  THEN
3369!
3370!-- Extensive green roof
3371!-- Set ratio of substrate layer thickness, soil-type and LAI
3372          soil_type = 3
3373          surf_usm_h%lai(m) = 2.0_wp
3374
3375          surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3376          surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3377          surf_usm_h%zw_green(nzb_wall+2,m) = 0.15_wp
3378          surf_usm_h%zw_green(nzb_wall+3,m) = 0.20_wp
3379       ELSE
3380!
3381!-- Intensiv green roof
3382!-- Set ratio of substrate layer thickness, soil-type and LAI
3383          soil_type = 6
3384          surf_usm_h%lai(m) = 4.0_wp
3385
3386          surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3387          surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3388          surf_usm_h%zw_green(nzb_wall+2,m) = 0.40_wp
3389          surf_usm_h%zw_green(nzb_wall+3,m) = 0.80_wp
3390       ENDIF
3391
3392       surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
3393       DO k = nzb_wall+1, nzt_wall
3394           surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) - surf_usm_h%zw_green(k-1,m)
3395       ENDDO
3396       surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
3397
3398       DO k = nzb_wall, nzt_wall-1
3399           surf_usm_h%dz_green_stag(k,m) = 0.5 * ( surf_usm_h%dz_green(k+1,m) +                    &
3400                                                   surf_usm_h%dz_green(k,m) )
3401       ENDDO
3402       surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
3403
3404      IF ( alpha_vangenuchten == 9999999.9_wp )  THEN
3405         alpha_vangenuchten = soil_pars(0,soil_type)
3406      ENDIF
3407
3408      IF ( l_vangenuchten == 9999999.9_wp )  THEN
3409         l_vangenuchten = soil_pars(1,soil_type)
3410      ENDIF
3411
3412      IF ( n_vangenuchten == 9999999.9_wp )  THEN
3413         n_vangenuchten = soil_pars(2,soil_type)
3414      ENDIF
3415
3416      IF ( hydraulic_conductivity == 9999999.9_wp )  THEN
3417         hydraulic_conductivity = soil_pars(3,soil_type)
3418      ENDIF
3419
3420      IF ( saturation_moisture == 9999999.9_wp )  THEN
3421         saturation_moisture = m_soil_pars(0,soil_type)
3422      ENDIF
3423
3424      IF ( field_capacity == 9999999.9_wp )  THEN
3425         field_capacity = m_soil_pars(1,soil_type)
3426      ENDIF
3427
3428      IF ( wilting_point == 9999999.9_wp )  THEN
3429         wilting_point = m_soil_pars(2,soil_type)
3430      ENDIF
3431
3432      IF ( residual_moisture == 9999999.9_wp )  THEN
3433         residual_moisture = m_soil_pars(3,soil_type)
3434      ENDIF
3435
3436      DO  k = nzb_wall, nzt_wall+1
3437         swc_h(k,m) = field_capacity
3438         rootfr_h(k,m) = 0.5_wp
3439         surf_usm_h%alpha_vg_green(m)      = alpha_vangenuchten
3440         surf_usm_h%l_vg_green(m)          = l_vangenuchten
3441         surf_usm_h%n_vg_green(m)          = n_vangenuchten
3442         surf_usm_h%gamma_w_green_sat(k,m) = hydraulic_conductivity
3443         swc_sat_h(k,m)                    = saturation_moisture
3444         fc_h(k,m)                         = field_capacity
3445         wilt_h(k,m)                       = wilting_point
3446         swc_res_h(k,m)                    = residual_moisture
3447      ENDDO
3448
3449    ENDDO
3450
3451    surf_usm_h%ddz_wall        = 1.0_wp / surf_usm_h%dz_wall
3452    surf_usm_h%ddz_wall_stag   = 1.0_wp / surf_usm_h%dz_wall_stag
3453    surf_usm_h%ddz_window      = 1.0_wp / surf_usm_h%dz_window
3454    surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
3455    surf_usm_h%ddz_green       = 1.0_wp / surf_usm_h%dz_green
3456    surf_usm_h%ddz_green_stag  = 1.0_wp / surf_usm_h%dz_green_stag
3457!
3458!-- For vertical surfaces
3459    DO  l = 0, 3
3460       DO  m = 1, surf_usm_v(l)%ns
3461          surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
3462          DO  k = nzb_wall+1, nzt_wall
3463             surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) - surf_usm_v(l)%zw(k-1,m)
3464          ENDDO
3465          surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
3466          DO  k = nzb_wall+1, nzt_wall
3467             surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) -                         &
3468                                            surf_usm_v(l)%zw_window(k-1,m)
3469          ENDDO
3470          surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
3471          DO  k = nzb_wall+1, nzt_wall
3472             surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) -                           &
3473                                           surf_usm_v(l)%zw_green(k-1,m)
3474          ENDDO
3475
3476          surf_usm_v(l)%dz_wall(nzt_wall+1,m) = surf_usm_v(l)%dz_wall(nzt_wall,m)
3477
3478          DO  k = nzb_wall, nzt_wall-1
3479             surf_usm_v(l)%dz_wall_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_wall(k+1,m) +              &
3480                                                       surf_usm_v(l)%dz_wall(k,m) )
3481          ENDDO
3482          surf_usm_v(l)%dz_wall_stag(nzt_wall,m) = surf_usm_v(l)%dz_wall(nzt_wall,m)
3483          surf_usm_v(l)%dz_window(nzt_wall+1,m)  = surf_usm_v(l)%dz_window(nzt_wall,m)
3484
3485          DO  k = nzb_wall, nzt_wall-1
3486             surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_window(k+1,m) +          &
3487                                                         surf_usm_v(l)%dz_window(k,m) )
3488          ENDDO
3489          surf_usm_v(l)%dz_window_stag(nzt_wall,m) = surf_usm_v(l)%dz_window(nzt_wall,m)
3490          surf_usm_v(l)%dz_green(nzt_wall+1,m)     = surf_usm_v(l)%dz_green(nzt_wall,m)
3491
3492          DO  k = nzb_wall, nzt_wall-1
3493             surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * ( surf_usm_v(l)%dz_green(k+1,m) +            &
3494                                                        surf_usm_v(l)%dz_green(k,m) )
3495          ENDDO
3496          surf_usm_v(l)%dz_green_stag(nzt_wall,m) = surf_usm_v(l)%dz_green(nzt_wall,m)
3497       ENDDO
3498       surf_usm_v(l)%ddz_wall        = 1.0_wp / surf_usm_v(l)%dz_wall
3499       surf_usm_v(l)%ddz_wall_stag   = 1.0_wp / surf_usm_v(l)%dz_wall_stag
3500       surf_usm_v(l)%ddz_window      = 1.0_wp / surf_usm_v(l)%dz_window
3501       surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
3502       surf_usm_v(l)%ddz_green       = 1.0_wp / surf_usm_v(l)%dz_green
3503       surf_usm_v(l)%ddz_green_stag  = 1.0_wp / surf_usm_v(l)%dz_green_stag
3504    ENDDO
3505
3506
3507    IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'end' )
3508
3509 END SUBROUTINE usm_init_material_model
3510
3511
3512!--------------------------------------------------------------------------------------------------!
3513! Description:
3514! ------------
3515!> Initialization of the urban surface model
3516!--------------------------------------------------------------------------------------------------!
3517 SUBROUTINE usm_init
3518
3519    USE arrays_3d,                                                                                 &
3520        ONLY:  zw
3521
3522    USE netcdf_data_input_mod,                                                                     &
3523        ONLY:  albedo_type_f,                                                                      &
3524               building_pars_f,                                                                    &
3525               building_surface_pars_f,                                                            &
3526               building_type_f,                                                                    &
3527               terrain_height_f
3528
3529    IMPLICIT NONE
3530
3531    INTEGER(iwp) ::  i                 !< loop index x-dirction
3532    INTEGER(iwp) ::  ind_alb_green     !< index in input list for green albedo
3533    INTEGER(iwp) ::  ind_alb_wall      !< index in input list for wall albedo
3534    INTEGER(iwp) ::  ind_alb_win       !< index in input list for window albedo
3535    INTEGER(iwp) ::  ind_emis_wall     !< index in input list for wall emissivity
3536    INTEGER(iwp) ::  ind_emis_green    !< index in input list for green emissivity
3537    INTEGER(iwp) ::  ind_emis_win      !< index in input list for window emissivity
3538    INTEGER(iwp) ::  ind_green_frac_w  !< index in input list for green fraction on wall
3539    INTEGER(iwp) ::  ind_green_frac_r  !< index in input list for green fraction on roof
3540    INTEGER(iwp) ::  ind_hc1           !< index in input list for heat capacity at first wall layer
3541    INTEGER(iwp) ::  ind_hc1_win       !< index in input list for heat capacity at first window layer
3542    INTEGER(iwp) ::  ind_hc2           !< index in input list for heat capacity at second wall layer
3543    INTEGER(iwp) ::  ind_hc2_win       !< index in input list for heat capacity at second window layer
3544    INTEGER(iwp) ::  ind_hc3           !< index in input list for heat capacity at third wall layer
3545    INTEGER(iwp) ::  ind_hc3_win       !< index in input list for heat capacity at third window layer
3546    INTEGER(iwp) ::  ind_lai_r         !< index in input list for LAI on roof
3547    INTEGER(iwp) ::  ind_lai_w         !< index in input list for LAI on wall
3548    INTEGER(iwp) ::  ind_tc1           !< index in input list for thermal conductivity at first wall layer
3549    INTEGER(iwp) ::  ind_tc1_win       !< index in input list for thermal conductivity at first window layer
3550    INTEGER(iwp) ::  ind_tc2           !< index in input list for thermal conductivity at second wall layer
3551    INTEGER(iwp) ::  ind_tc2_win       !< index in input list for thermal conductivity at second window layer
3552    INTEGER(iwp) ::  ind_tc3           !< index in input list for thermal conductivity at third wall layer
3553    INTEGER(iwp) ::  ind_tc3_win       !< index in input list for thermal conductivity at third window layer
3554    INTEGER(iwp) ::  ind_thick_1       !< index in input list for thickness of first wall layer
3555    INTEGER(iwp) ::  ind_thick_1_win   !< index in input list for thickness of first window layer
3556    INTEGER(iwp) ::  ind_thick_2       !< index in input list for thickness of second wall layer
3557    INTEGER(iwp) ::  ind_thick_2_win   !< index in input list for thickness of second window layer
3558    INTEGER(iwp) ::  ind_thick_3       !< index in input list for thickness of third wall layer
3559    INTEGER(iwp) ::  ind_thick_3_win   !< index in input list for thickness of third window layer
3560    INTEGER(iwp) ::  ind_thick_4       !< index in input list for thickness of fourth wall layer
3561    INTEGER(iwp) ::  ind_thick_4_win   !< index in input list for thickness of fourth window layer
3562    INTEGER(iwp) ::  ind_trans         !< index in input list for window transmissivity
3563    INTEGER(iwp) ::  ind_wall_frac     !< index in input list for wall fraction
3564    INTEGER(iwp) ::  ind_win_frac      !< index in input list for window fraction
3565    INTEGER(iwp) ::  ind_z0            !< index in input list for z0
3566    INTEGER(iwp) ::  ind_z0qh          !< index in input list for z0h / z0q
3567    INTEGER(iwp) ::  is                !< loop index input surface element
3568    INTEGER(iwp) ::  j                 !< loop index y-dirction
3569    INTEGER(iwp) ::  k                 !< loop index z-dirction
3570    INTEGER(iwp) ::  l                 !< loop index surface orientation
3571    INTEGER(iwp) ::  m                 !< loop index surface element
3572    INTEGER(iwp) ::  st                !< dummy
3573
3574    LOGICAL      ::  relative_fractions_corrected  !< flag indicating if relative surface fractions require normalization
3575
3576    REAL(wp)     ::  c, tin, twin          !<
3577    REAL(wp)     ::  ground_floor_level_l  !< local height of ground floor level
3578    REAL(wp)     ::  sum_frac              !< sum of the relative material fractions at a surface element
3579    REAL(wp)     ::  z_agl                 !< height of the surface element above terrain
3580
3581    IF ( debug_output )  CALL debug_message( 'usm_init', 'start' )
3582
3583    CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
3584!
3585!-- Surface forcing has to be disabled for LSF in case of enabled urban surface module
3586    IF ( large_scale_forcing )  THEN
3587        lsf_surf = .FALSE.
3588    ENDIF
3589!
3590!-- Calculate constant values
3591    d_roughness_concrete = 1.0_wp / roughness_concrete
3592!
3593!-- Flag surface elements belonging to the ground floor level. Therefore, use terrain height array
3594!-- from file, if available. This flag is later used to control initialization of surface attributes.
3595!-- Todo: for the moment disable initialization of building roofs with ground-floor-level properties.
3596    surf_usm_h%ground_level = .FALSE.
3597
3598    DO  l = 0, 3
3599       surf_usm_v(l)%ground_level = .FALSE.
3600       DO  m = 1, surf_usm_v(l)%ns
3601          i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
3602          j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
3603          k = surf_usm_v(l)%k(m)
3604!
3605!--       Determine local ground level. Level 1 - default value, level 2 - initialization according
3606!--       to building type, level 3 - initialization from value read from file.
3607          ground_floor_level_l = ground_floor_level
3608
3609          IF ( building_type_f%from_file )  THEN
3610              ground_floor_level_l = building_pars(ind_gflh,building_type_f%var(j,i))
3611          ENDIF
3612
3613          IF ( building_pars_f%from_file )  THEN
3614             IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=  building_pars_f%fill )                 &
3615                ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
3616          ENDIF
3617!
3618!--       Determine height of surface element above ground level. Please note, the height of a
3619!--       surface element is determined with respect to its height above ground of the reference
3620!--       grid point in the atmosphere. Therefore, substract the offset values when assessing the
3621!--       terrain height.
3622          IF ( terrain_height_f%from_file )  THEN
3623             z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff, i-surf_usm_v(l)%ioff)
3624          ELSE
3625             z_agl = zw(k)
3626          ENDIF
3627!
3628!--       Set flag for ground level
3629          IF ( z_agl <= ground_floor_level_l ) surf_usm_v(l)%ground_level(m) = .TRUE.
3630
3631       ENDDO
3632    ENDDO
3633!
3634!-- Initialization of resistances.
3635    DO  m = 1, surf_usm_h%ns
3636       surf_usm_h%r_a(m)        = 50.0_wp
3637       surf_usm_h%r_a_green(m)  = 50.0_wp
3638       surf_usm_h%r_a_window(m) = 50.0_wp
3639    ENDDO
3640    DO  l = 0, 3
3641       DO  m = 1, surf_usm_v(l)%ns
3642          surf_usm_v(l)%r_a(m)        = 50.0_wp
3643          surf_usm_v(l)%r_a_green(m)  = 50.0_wp
3644          surf_usm_v(l)%r_a_window(m) = 50.0_wp
3645       ENDDO
3646    ENDDO
3647
3648!
3649!-- Map values onto horizontal elemements
3650    DO  m = 1, surf_usm_h%ns
3651       surf_usm_h%r_canopy(m)     = 200.0_wp !< canopy_resistance
3652       surf_usm_h%r_canopy_min(m) = 200.0_wp !< min_canopy_resistance
3653       surf_usm_h%g_d(m)          = 0.0_wp   !< canopy_resistance_coefficient
3654    ENDDO
3655!
3656!-- Map values onto vertical elements, even though this does not make much sense.
3657    DO  l = 0, 3
3658       DO  m = 1, surf_usm_v(l)%ns
3659          surf_usm_v(l)%r_canopy(m)     = 200.0_wp !< canopy_resistance
3660          surf_usm_v(l)%r_canopy_min(m) = 200.0_wp !< min_canopy_resistance
3661          surf_usm_v(l)%g_d(m)          = 0.0_wp   !< canopy_resistance_coefficient
3662       ENDDO
3663    ENDDO
3664
3665!
3666!--  Initialize urban-type surface attribute. According to initialization in land-surface model,
3667!--  follow a 3-level approach.
3668!--  Level 1 - initialization via default attributes
3669     DO  m = 1, surf_usm_h%ns
3670!
3671!--     Now, all horizontal surfaces are roof surfaces (?)
3672        surf_usm_h%isroof_surf(m)   = .TRUE.
3673        surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
3674!
3675!--     In order to distinguish between ground floor level and above-ground-floor level surfaces,
3676!--     set input indices.
3677
3678        ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                     &
3679                                  surf_usm_h%ground_level(m) )
3680        ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h%ground_level(m) )
3681        ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h%ground_level(m) )
3682        ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h%ground_level(m) )
3683!
3684!--     Store building type and its name on each surface element
3685        surf_usm_h%building_type(m)      = building_type
3686        surf_usm_h%building_type_name(m) = building_type_name(building_type)
3687!
3688!--     Initialize relatvie wall- (0), green- (1) and window (2) fractions
3689        surf_usm_h%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac_r,building_type)
3690        surf_usm_h%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,building_type)
3691        surf_usm_h%frac(m,ind_wat_win)   = building_pars(ind_win_frac_r,building_type)
3692        surf_usm_h%lai(m)                = building_pars(ind_lai_r,building_type)
3693
3694        surf_usm_h%rho_c_wall(nzb_wall,m)        = building_pars(ind_hc1_wall_r,building_type)
3695        surf_usm_h%rho_c_wall(nzb_wall+1,m)      = building_pars(ind_hc1_wall_r,building_type)
3696        surf_usm_h%rho_c_wall(nzb_wall+2,m)      = building_pars(ind_hc2_wall_r,building_type)
3697        surf_usm_h%rho_c_wall(nzb_wall+3,m)      = building_pars(ind_hc3_wall_r,building_type)
3698        surf_usm_h%lambda_h(nzb_wall,m)          = building_pars(ind_tc1_wall_r,building_type)
3699        surf_usm_h%lambda_h(nzb_wall+1,m)        = building_pars(ind_tc1_wall_r,building_type)
3700        surf_usm_h%lambda_h(nzb_wall+2,m)        = building_pars(ind_tc2_wall_r,building_type)
3701        surf_usm_h%lambda_h(nzb_wall+3,m)        = building_pars(ind_tc3_wall_r,building_type)
3702        surf_usm_h%rho_c_green(nzb_wall,m)       = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
3703        surf_usm_h%rho_c_green(nzb_wall+1,m)     = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
3704        surf_usm_h%rho_c_green(nzb_wall+2,m)     = rho_c_soil !building_pars(ind_hc2_wall_r,building_type)
3705        surf_usm_h%rho_c_green(nzb_wall+3,m)     = rho_c_soil !building_pars(ind_hc3_wall_r,building_type)
3706        surf_usm_h%lambda_h_green(nzb_wall,m)    = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
3707        surf_usm_h%lambda_h_green(nzb_wall+1,m)  = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
3708        surf_usm_h%lambda_h_green(nzb_wall+2,m)  = lambda_h_green_sm !building_pars(ind_tc2_wall_r,building_type)
3709        surf_usm_h%lambda_h_green(nzb_wall+3,m)  = lambda_h_green_sm !building_pars(ind_tc3_wall_r,building_type)
3710        surf_usm_h%rho_c_window(nzb_wall,m)      = building_pars(ind_hc1_win_r,building_type)
3711        surf_usm_h%rho_c_window(nzb_wall+1,m)    = building_pars(ind_hc1_win_r,building_type)
3712        surf_usm_h%rho_c_window(nzb_wall+2,m)    = building_pars(ind_hc2_win_r,building_type)
3713        surf_usm_h%rho_c_window(nzb_wall+3,m)    = building_pars(ind_hc3_win_r,building_type)
3714        surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,building_type)
3715        surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,building_type)
3716        surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,building_type)
3717        surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,building_type)
3718
3719        surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)
3720        surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
3721!
3722!--     Emissivity of wall-, green- and window fraction
3723        surf_usm_h%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,building_type)
3724        surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,building_type)
3725        surf_usm_h%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win_r,building_type)
3726
3727        surf_usm_h%transmissivity(m)           = building_pars(ind_trans_r,building_type)
3728
3729        surf_usm_h%z0(m)                       = building_pars(ind_z0,building_type)
3730        surf_usm_h%z0h(m)                      = building_pars(ind_z0qh,building_type)
3731        surf_usm_h%z0q(m)                      = building_pars(ind_z0qh,building_type)
3732!
3733!--     Albedo type for wall fraction, green fraction, window fraction
3734        surf_usm_h%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,building_type) )
3735        surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,building_type) )
3736        surf_usm_h%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win_r,building_type) )
3737
3738        surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3739        surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3740        surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3741        surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3742
3743        surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3744        surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3745        surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3746        surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3747
3748        surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,building_type)
3749        surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,building_type)
3750        surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,building_type)
3751        surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,building_type)
3752
3753        surf_usm_h%green_type_roof(m)     = building_pars(ind_green_type_roof,building_type)
3754
3755     ENDDO
3756
3757     DO  l = 0, 3
3758        DO  m = 1, surf_usm_v(l)%ns
3759
3760           surf_usm_v(l)%surface_types(m) = wall_category     !< Default category for root surface
3761!
3762!--        In order to distinguish between ground floor level and above-ground-floor level surfaces,
3763!--        set input indices.
3764           ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,                     &
3765                                     surf_usm_v(l)%ground_level(m) )
3766           ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,                      &
3767                                     surf_usm_v(l)%ground_level(m) )
3768           ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,                       &
3769                                     surf_usm_v(l)%ground_level(m) )
3770           ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,                     &
3771                                     surf_usm_v(l)%ground_level(m) )
3772           ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,                      &
3773                                     surf_usm_v(l)%ground_level(m) )
3774           ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl,                  &
3775                                     surf_usm_v(l)%ground_level(m) )
3776           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                  &
3777                                     surf_usm_v(l)%ground_level(m) )
3778           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,                         &
3779                                     surf_usm_v(l)%ground_level(m) )
3780           ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,                         &
3781                                     surf_usm_v(l)%ground_level(m) )
3782           ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,                           &
3783                                     surf_usm_v(l)%ground_level(m) )
3784           ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,                       &
3785                                     surf_usm_v(l)%ground_level(m) )
3786           ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,                           &
3787                                     surf_usm_v(l)%ground_level(m) )
3788           ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,                       &
3789                                     surf_usm_v(l)%ground_level(m) )
3790           ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,                           &
3791                                     surf_usm_v(l)%ground_level(m) )
3792           ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,                       &
3793                                     surf_usm_v(l)%ground_level(m) )
3794           ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,                           &
3795                                     surf_usm_v(l)%ground_level(m) )
3796           ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,                       &
3797                                     surf_usm_v(l)%ground_level(m) )
3798           ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,                           &
3799                                     surf_usm_v(l)%ground_level(m) )
3800           ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,                       &
3801                                     surf_usm_v(l)%ground_level(m) )
3802           ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,                           &
3803                                     surf_usm_v(l)%ground_level(m) )
3804           ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,                       &
3805                                     surf_usm_v(l)%ground_level(m) )
3806           ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,                       &
3807                                     surf_usm_v(l)%ground_level(m) )
3808           ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,                   &
3809                                     surf_usm_v(l)%ground_level(m) )
3810           ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,                       &
3811                                     surf_usm_v(l)%ground_level(m) )
3812           ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,                   &
3813                                     surf_usm_v(l)%ground_level(m) )
3814           ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,                       &
3815                                     surf_usm_v(l)%ground_level(m) )
3816           ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,                   &
3817                                     surf_usm_v(l)%ground_level(m) )
3818           ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,                       &
3819                                     surf_usm_v(l)%ground_level(m) )
3820           ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,                   &
3821                                     surf_usm_v(l)%ground_level(m) )
3822           ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,                     &
3823                                     surf_usm_v(l)%ground_level(m) )
3824           ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,                    &
3825                                     surf_usm_v(l)%ground_level(m) )
3826           ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,                      &
3827                                     surf_usm_v(l)%ground_level(m) )
3828           ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,                          &
3829                                     surf_usm_v(l)%ground_level(m) )
3830           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,                            &
3831                                     surf_usm_v(l)%ground_level(m) )
3832           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,                          &
3833                                     surf_usm_v(l)%ground_level(m) )
3834!
3835!--        Store building type and its name on each surface element
3836           surf_usm_v(l)%building_type(m)      = building_type
3837           surf_usm_v(l)%building_type_name(m) = building_type_name(building_type)
3838!
3839!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
3840           surf_usm_v(l)%frac(m,ind_veg_wall)   = building_pars(ind_wall_frac,building_type)
3841           surf_usm_v(l)%frac(m,ind_pav_green)  = building_pars(ind_green_frac_w,building_type)
3842           surf_usm_v(l)%frac(m,ind_wat_win)    = building_pars(ind_win_frac,building_type)
3843           surf_usm_v(l)%lai(m)                 = building_pars(ind_lai_w,building_type)
3844
3845           surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type)
3846           surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3847           surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3848           surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3849
3850           surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,building_type)
3851           surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,building_type)
3852           surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,building_type)
3853           surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,building_type)
3854
3855           surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,building_type)
3856           surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,building_type)
3857           surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,building_type)
3858           surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,building_type)
3859
3860           surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type)
3861           surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3862           surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3863           surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3864
3865           surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,building_type)
3866           surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,building_type)
3867           surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,building_type)
3868           surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,building_type)
3869
3870           surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,building_type)
3871           surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,building_type)
3872           surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,building_type)
3873           surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,building_type)
3874
3875           surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)
3876           surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
3877!
3878!--        Emissivity of wall-, green- and window fraction
3879           surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,building_type)
3880           surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,building_type)
3881           surf_usm_v(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win,building_type)
3882
3883           surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,building_type)
3884
3885           surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,building_type)
3886           surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,building_type)
3887           surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,building_type)
3888
3889           surf_usm_v(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall,building_type) )
3890           surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,building_type) )
3891           surf_usm_v(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win,building_type) )
3892
3893           surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
3894           surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
3895           surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
3896           surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
3897
3898           surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
3899           surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
3900           surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
3901           surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
3902
3903           surf_usm_v(l)%zw_window(nzb_wall,m)        = building_pars(ind_thick_1_win,building_type)
3904           surf_usm_v(l)%zw_window(nzb_wall+1,m)      = building_pars(ind_thick_2_win,building_type)
3905           surf_usm_v(l)%zw_window(nzb_wall+2,m)      = building_pars(ind_thick_3_win,building_type)
3906           surf_usm_v(l)%zw_window(nzb_wall+3,m)      = building_pars(ind_thick_4_win,building_type)
3907
3908        ENDDO
3909     ENDDO
3910!
3911!--  Level 2 - initialization via building type read from file
3912     IF ( building_type_f%from_file )  THEN
3913        DO  m = 1, surf_usm_h%ns
3914           i = surf_usm_h%i(m)
3915           j = surf_usm_h%j(m)
3916!
3917!--        For the moment, limit building type to 6 (to overcome errors in input file).
3918           st = building_type_f%var(j,i)
3919           IF ( st /= building_type_f%fill )  THEN
3920
3921!
3922!--           In order to distinguish between ground floor level and above-ground-floor level
3923!--           surfaces, set input indices.
3924
3925              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,               &
3926                                        surf_usm_h%ground_level(m) )
3927              ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h%ground_level(m) )
3928              ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h%ground_level(m) )
3929              ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h%ground_level(m) )
3930!
3931!--           Store building type and its name on each surface element
3932              surf_usm_h%building_type(m)      = st
3933              surf_usm_h%building_type_name(m) = building_type_name(st)
3934!
3935!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
3936              surf_usm_h%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac_r,st)
3937              surf_usm_h%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,st)
3938              surf_usm_h%frac(m,ind_wat_win)   = building_pars(ind_win_frac_r,st)
3939              surf_usm_h%lai(m)                = building_pars(ind_lai_r,st)
3940
3941              surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,st)
3942              surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1_wall_r,st)
3943              surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2_wall_r,st)
3944              surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3_wall_r,st)
3945              surf_usm_h%lambda_h(nzb_wall,m)     = building_pars(ind_tc1_wall_r,st)
3946              surf_usm_h%lambda_h(nzb_wall+1,m)   = building_pars(ind_tc1_wall_r,st)
3947              surf_usm_h%lambda_h(nzb_wall+2,m)   = building_pars(ind_tc2_wall_r,st)
3948              surf_usm_h%lambda_h(nzb_wall+3,m)   = building_pars(ind_tc3_wall_r,st)
3949
3950              surf_usm_h%rho_c_green(nzb_wall,m)      = rho_c_soil !building_pars(ind_hc1_wall_r,st)
3951              surf_usm_h%rho_c_green(nzb_wall+1,m)    = rho_c_soil !building_pars(ind_hc1_wall_r,st)
3952              surf_usm_h%rho_c_green(nzb_wall+2,m)    = rho_c_soil !building_pars(ind_hc2_wall_r,st)
3953              surf_usm_h%rho_c_green(nzb_wall+3,m)    = rho_c_soil !building_pars(ind_hc3_wall_r,st)
3954              surf_usm_h%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
3955              surf_usm_h%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
3956              surf_usm_h%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,st)
3957              surf_usm_h%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,st)
3958
3959              surf_usm_h%rho_c_window(nzb_wall,m)      = building_pars(ind_hc1_win_r,st)
3960              surf_usm_h%rho_c_window(nzb_wall+1,m)    = building_pars(ind_hc1_win_r,st)
3961              surf_usm_h%rho_c_window(nzb_wall+2,m)    = building_pars(ind_hc2_win_r,st)
3962              surf_usm_h%rho_c_window(nzb_wall+3,m)    = building_pars(ind_hc3_win_r,st)
3963              surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,st)
3964              surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,st)
3965              surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,st)
3966              surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,st)
3967
3968              surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)
3969              surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)
3970!
3971!--           Emissivity of wall-, green- and window fraction
3972              surf_usm_h%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,st)
3973              surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,st)
3974              surf_usm_h%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win_r,st)
3975
3976              surf_usm_h%transmissivity(m)      = building_pars(ind_trans_r,st)
3977
3978              surf_usm_h%z0(m)                  = building_pars(ind_z0,st)
3979              surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,st)
3980              surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
3981!
3982!--           Albedo type for wall fraction, green fraction, window fraction
3983              surf_usm_h%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,st) )
3984              surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,st) )
3985              surf_usm_h%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win_r,st) )
3986
3987              surf_usm_h%zw(nzb_wall,m)   = building_pars(ind_thick_1_wall_r,st)
3988              surf_usm_h%zw(nzb_wall+1,m) = building_pars(ind_thick_2_wall_r,st)
3989              surf_usm_h%zw(nzb_wall+2,m) = building_pars(ind_thick_3_wall_r,st)
3990              surf_usm_h%zw(nzb_wall+3,m) = building_pars(ind_thick_4_wall_r,st)
3991
3992              surf_usm_h%zw_green(nzb_wall,m)   = building_pars(ind_thick_1_wall_r,st)
3993              surf_usm_h%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2_wall_r,st)
3994              surf_usm_h%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3_wall_r,st)
3995              surf_usm_h%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4_wall_r,st)
3996
3997              surf_usm_h%zw_window(nzb_wall,m)   = building_pars(ind_thick_1_win_r,st)
3998              surf_usm_h%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2_win_r,st)
3999              surf_usm_h%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3_win_r,st)
4000              surf_usm_h%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4_win_r,st)
4001
4002              surf_usm_h%green_type_roof(m) = building_pars(ind_green_type_roof,st)
4003
4004           ENDIF
4005        ENDDO
4006
4007        DO  l = 0, 3
4008           DO  m = 1, surf_usm_v(l)%ns
4009              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4010              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4011!
4012!--           For the moment, limit building type to 6 (to overcome errors in input file).
4013
4014              st = building_type_f%var(j,i)
4015              IF ( st /= building_type_f%fill )  THEN
4016
4017!
4018!--              In order to distinguish between ground floor level and above-ground-floor level
4019!--              surfaces, set input indices.
4020                 ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,               &
4021                                           surf_usm_v(l)%ground_level(m) )
4022                 ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,                &
4023                                           surf_usm_v(l)%ground_level(m) )
4024                 ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,                 &
4025                                           surf_usm_v(l)%ground_level(m) )
4026                 ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,               &
4027                                           surf_usm_v(l)%ground_level(m) )
4028                 ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,                &
4029                                           surf_usm_v(l)%ground_level(m) )
4030                 ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl,            &
4031                                           surf_usm_v(l)%ground_level(m) )
4032                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,            &
4033                                           surf_usm_v(l)%ground_level(m) )
4034                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,                   &
4035                                           surf_usm_v(l)%ground_level(m) )
4036                 ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,                   &
4037                                           surf_usm_v(l)%ground_level(m) )
4038                 ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,                     &
4039                                           surf_usm_v(l)%ground_level(m) )
4040                 ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,                 &
4041                                           surf_usm_v(l)%ground_level(m) )
4042                 ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,                     &
4043                                           surf_usm_v(l)%ground_level(m) )
4044                 ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,                 &
4045                                           surf_usm_v(l)%ground_level(m) )
4046                 ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,                     &
4047                                           surf_usm_v(l)%ground_level(m) )
4048                 ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,                 &
4049                                           surf_usm_v(l)%ground_level(m) )
4050                 ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,                     &
4051                                           surf_usm_v(l)%ground_level(m) )
4052                 ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,                 &
4053                                           surf_usm_v(l)%ground_level(m) )
4054                 ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,                     &
4055                                           surf_usm_v(l)%ground_level(m) )
4056                 ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,                 &
4057                                           surf_usm_v(l)%ground_level(m) )
4058                 ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,                     &
4059                                           surf_usm_v(l)%ground_level(m) )
4060                 ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,                 &
4061                                           surf_usm_v(l)%ground_level(m) )
4062                 ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,                 &
4063                                           surf_usm_v(l)%ground_level(m) )
4064                 ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,             &
4065                                           surf_usm_v(l)%ground_level(m) )
4066                 ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,                 &
4067                                           surf_usm_v(l)%ground_level(m) )
4068                 ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,             &
4069                                           surf_usm_v(l)%ground_level(m) )
4070                 ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,                 &
4071                                           surf_usm_v(l)%ground_level(m) )
4072                 ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,             &
4073                                           surf_usm_v(l)%ground_level(m) )
4074                 ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,                 &
4075                                           surf_usm_v(l)%ground_level(m) )
4076                 ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,             &
4077                                           surf_usm_v(l)%ground_level(m) )
4078                 ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,               &
4079                                           surf_usm_v(l)%ground_level(m) )
4080                 ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,              &
4081                                           surf_usm_v(l)%ground_level(m) )
4082                 ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,                &
4083                                           surf_usm_v(l)%ground_level(m) )
4084                 ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,                    &
4085                                         surf_usm_v(l)%ground_level(m) )
4086                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,                      &
4087                                           surf_usm_v(l)%ground_level(m) )
4088                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,                    &
4089                                           surf_usm_v(l)%ground_level(m) )
4090!
4091!--              Store building type and its name on each surface element
4092                 surf_usm_v(l)%building_type(m)      = st
4093                 surf_usm_v(l)%building_type_name(m) = building_type_name(st)
4094!
4095!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
4096                 surf_usm_v(l)%frac(m,ind_veg_wall)  = building_pars(ind_wall_frac,st)
4097                 surf_usm_v(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_w,st)
4098                 surf_usm_v(l)%frac(m,ind_wat_win)   = building_pars(ind_win_frac,st)
4099                 surf_usm_v(l)%lai(m)                = building_pars(ind_lai_w,st)
4100
4101                 surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st)
4102                 surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
4103                 surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
4104                 surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
4105
4106                 surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,st)
4107                 surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,st)
4108                 surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,st)
4109                 surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,st)
4110
4111                 surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,st)
4112                 surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,st)
4113                 surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,st)
4114                 surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,st)
4115
4116                 surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st)
4117                 surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st)
4118                 surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
4119                 surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)
4120
4121                 surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,st)
4122                 surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,st)
4123                 surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,st)
4124                 surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,st)
4125
4126                 surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,st)
4127                 surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,st)
4128                 surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,st)
4129                 surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,st)
4130
4131                 surf_usm_v(l)%target_temp_summer(m) = building_pars(ind_indoor_target_temp_summer,st)
4132                 surf_usm_v(l)%target_temp_winter(m) = building_pars(ind_indoor_target_temp_winter,st)
4133!
4134!--              Emissivity of wall-, green- and window fraction
4135                 surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,st)
4136                 surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,st)
4137                 surf_usm_v(l)%emissivity(m,ind_wat_win)   = building_pars(ind_emis_win,st)
4138
4139                 surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,st)
4140
4141                 surf_usm_v(l)%z0(m)  = building_pars(ind_z0,st)
4142                 surf_usm_v(l)%z0h(m) = building_pars(ind_z0qh,st)
4143                 surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,st)
4144
4145                 surf_usm_v(l)%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall,st) )
4146                 surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,st) )
4147                 surf_usm_v(l)%albedo_type(m,ind_wat_win)   = INT( building_pars(ind_alb_win,st) )
4148
4149                 surf_usm_v(l)%zw(nzb_wall,m)   = building_pars(ind_thick_1,st)
4150                 surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4151                 surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4152                 surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4153
4154                 surf_usm_v(l)%zw_green(nzb_wall,m)   = building_pars(ind_thick_1,st)
4155                 surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4156                 surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4157                 surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4158
4159                 surf_usm_v(l)%zw_window(nzb_wall,m)   = building_pars(ind_thick_1_win,st)
4160                 surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2_win,st)
4161                 surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3_win,st)
4162                 surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4_win,st)
4163
4164              ENDIF
4165           ENDDO
4166        ENDDO
4167     ENDIF
4168
4169!
4170!--  Level 3 - initialization via building_pars read from file. Note, only variables that are also
4171!--  defined in the input-standard can be initialized via file. Other variables will be initialized
4172!--  on level 1 or 2.
4173     IF ( building_pars_f%from_file )  THEN
4174        DO  m = 1, surf_usm_h%ns
4175           i = surf_usm_h%i(m)
4176           j = surf_usm_h%j(m)
4177
4178!
4179!--        In order to distinguish between ground floor level and above-ground-floor level surfaces,
4180!--        set input indices.
4181           ind_wall_frac    = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl,                        &
4182                                     surf_usm_h%ground_level(m) )
4183           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl,                  &
4184                                     surf_usm_h%ground_level(m) )
4185           ind_win_frac     = MERGE( ind_win_frac_gfl, ind_win_frac_agfl,                          &
4186                                     surf_usm_h%ground_level(m) )
4187           ind_lai_r        = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, surf_usm_h%ground_level(m) )
4188           ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl, surf_usm_h%ground_level(m) )
4189           ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, surf_usm_h%ground_level(m) )
4190           ind_hc1          = MERGE( ind_hc1_gfl, ind_hc1_agfl, surf_usm_h%ground_level(m) )
4191           ind_hc2          = MERGE( ind_hc2_gfl, ind_hc2_agfl, surf_usm_h%ground_level(m) )
4192           ind_hc3          = MERGE( ind_hc3_gfl, ind_hc3_agfl, surf_usm_h%ground_level(m) )
4193           ind_tc1          = MERGE( ind_tc1_gfl, ind_tc1_agfl, surf_usm_h%ground_level(m) )
4194           ind_tc2          = MERGE( ind_tc2_gfl, ind_tc2_agfl, surf_usm_h%ground_level(m) )
4195           ind_tc3          = MERGE( ind_tc3_gfl, ind_tc3_agfl, surf_usm_h%ground_level(m) )
4196           ind_emis_wall    = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl,                        &
4197                                     surf_usm_h%ground_level(m) )
4198           ind_emis_green   = MERGE( ind_emis_green_gfl, ind_emis_green_agfl,                      &
4199                                     surf_usm_h%ground_level(m) )
4200           ind_emis_win     = MERGE( ind_emis_win_gfl, ind_emis_win_agfl,                          &
4201                                     surf_usm_h%ground_level(m) )
4202           ind_trans        = MERGE( ind_trans_gfl, ind_trans_agfl, surf_usm_h%ground_level(m) )
4203
4204!
4205!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
4206           IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill )               &
4207              surf_usm_h%frac(m,ind_veg_wall) = building_pars_f%pars_xy(ind_wall_frac,j,i)
4208
4209           IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /= building_pars_f%fill )            &
4210              surf_usm_h%frac(m,ind_pav_green) = building_pars_f%pars_xy(ind_green_frac_r,j,i)
4211
4212           IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill )                &
4213              surf_usm_h%frac(m,ind_wat_win) = building_pars_f%pars_xy(ind_win_frac,j,i)
4214
4215           IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /= building_pars_f%fill )                   &
4216              surf_usm_h%lai(m) = building_pars_f%pars_xy(ind_lai_r,j,i)
4217
4218           IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4219              surf_usm_h%rho_c_wall(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4220              surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4221           ENDIF
4222
4223
4224           IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
4225              surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4226
4227           IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
4228              surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4229
4230           IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4231              surf_usm_h%rho_c_green(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4232              surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4233           ENDIF
4234           IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
4235              surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4236
4237           IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
4238              surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4239
4240           IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4241              surf_usm_h%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4242              surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4243           ENDIF
4244           IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                     &
4245              surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4246
4247           IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                     &
4248              surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4249
4250           IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4251              surf_usm_h%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)
4252              surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4253           ENDIF
4254           IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
4255              surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4256
4257           IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
4258              surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4259
4260           IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4261              surf_usm_h%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4262              surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4263           ENDIF
4264           IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
4265              surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4266
4267           IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
4268              surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4269
4270           IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4271              surf_usm_h%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4272              surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4273           ENDIF
4274           IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                     &
4275              surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4276
4277           IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                     &
4278              surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4279
4280           IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=                      &
4281                building_pars_f%fill )                                                             &
4282              surf_usm_h%target_temp_summer(m) =                                                   &
4283              building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)
4284
4285           IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=                      &
4286                building_pars_f%fill )                                                             &
4287              surf_usm_h%target_temp_winter(m) =                                                   &
4288              building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)
4289
4290           IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill )               &
4291              surf_usm_h%emissivity(m,ind_veg_wall) = building_pars_f%pars_xy(ind_emis_wall,j,i)
4292
4293           IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )              &
4294              surf_usm_h%emissivity(m,ind_pav_green) = building_pars_f%pars_xy(ind_emis_green,j,i)
4295
4296           IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )                &
4297              surf_usm_h%emissivity(m,ind_wat_win) = building_pars_f%pars_xy(ind_emis_win,j,i)
4298
4299           IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )                   &
4300              surf_usm_h%transmissivity(m) = building_pars_f%pars_xy(ind_trans,j,i)
4301
4302           IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )                      &
4303              surf_usm_h%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4304
4305           IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                    &
4306              surf_usm_h%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4307
4308           IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                    &
4309              surf_usm_h%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4310
4311           IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= building_pars_f%fill )           &
4312              surf_usm_h%albedo_type(m,ind_veg_wall)  =                                            &
4313              building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4314
4315           IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= building_pars_f%fill )          &
4316              surf_usm_h%albedo_type(m,ind_pav_green) =                                            &
4317              building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4318
4319           IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= building_pars_f%fill )            &
4320              surf_usm_h%albedo_type(m,ind_wat_win)   =                                            &
4321              building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4322
4323           IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )            &
4324              surf_usm_h%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4325
4326           IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )            &
4327              surf_usm_h%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4328
4329           IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )            &
4330              surf_usm_h%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4331
4332           IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )            &
4333              surf_usm_h%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4334
4335           IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )            &
4336              surf_usm_h%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4337
4338           IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )            &
4339              surf_usm_h%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4340
4341           IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )            &
4342              surf_usm_h%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4343
4344           IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )            &
4345              surf_usm_h%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4346        ENDDO
4347
4348        DO  l = 0, 3
4349           DO  m = 1, surf_usm_v(l)%ns
4350              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4351              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4352
4353!
4354!--           In order to distinguish between ground floor level and above-ground-floor level
4355!--           surfaces, set input indices.
4356              ind_wall_frac    = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl,                     &
4357                                        surf_usm_v(l)%ground_level(m) )
4358              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl,               &
4359                                        surf_usm_v(l)%ground_level(m) )
4360              ind_win_frac     = MERGE( ind_win_frac_gfl, ind_win_frac_agfl,                       &
4361                                        surf_usm_v(l)%ground_level(m) )
4362              ind_lai_w        = MERGE( ind_lai_w_gfl, ind_lai_w_agfl,                             &
4363                                        surf_usm_v(l)%ground_level(m) )
4364              ind_z0           = MERGE( ind_z0_gfl, ind_z0_agfl,                                   &
4365                                        surf_usm_v(l)%ground_level(m) )
4366              ind_z0qh         = MERGE( ind_z0qh_gfl, ind_z0qh_agfl,                               &
4367                                        surf_usm_v(l)%ground_level(m) )
4368              ind_hc1          = MERGE( ind_hc1_gfl, ind_hc1_agfl,                                 &
4369                                        surf_usm_v(l)%ground_level(m) )
4370              ind_hc2          = MERGE( ind_hc2_gfl, ind_hc2_agfl,                                 &
4371                                        surf_usm_v(l)%ground_level(m) )
4372              ind_hc3          = MERGE( ind_hc3_gfl, ind_hc3_agfl,                                 &
4373                                        surf_usm_v(l)%ground_level(m) )
4374              ind_tc1          = MERGE( ind_tc1_gfl, ind_tc1_agfl,                                 &
4375                                        surf_usm_v(l)%ground_level(m) )
4376              ind_tc2          = MERGE( ind_tc2_gfl, ind_tc2_agfl,                                 &
4377                                        surf_usm_v(l)%ground_level(m) )
4378              ind_tc3          = MERGE( ind_tc3_gfl, ind_tc3_agfl,                                 &
4379                                        surf_usm_v(l)%ground_level(m) )
4380              ind_emis_wall    = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl,                     &
4381                                        surf_usm_v(l)%ground_level(m) )
4382              ind_emis_green   = MERGE( ind_emis_green_gfl, ind_emis_green_agfl,                   &
4383                                        surf_usm_v(l)%ground_level(m) )
4384              ind_emis_win     = MERGE( ind_emis_win_gfl, ind_emis_win_agfl,                       &
4385                                        surf_usm_v(l)%ground_level(m) )
4386              ind_trans        = MERGE( ind_trans_gfl, ind_trans_agfl,                             &
4387                                        surf_usm_v(l)%ground_level(m) )
4388
4389!
4390!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
4391              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill )            &
4392                 surf_usm_v(l)%frac(m,ind_veg_wall) = building_pars_f%pars_xy(ind_wall_frac,j,i)
4393
4394              IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /= building_pars_f%fill )         &
4395                 surf_usm_v(l)%frac(m,ind_pav_green) =                                             &
4396                 building_pars_f%pars_xy(ind_green_frac_w,j,i)
4397
4398              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill )             &
4399                 surf_usm_v(l)%frac(m,ind_wat_win) = building_pars_f%pars_xy(ind_win_frac,j,i)
4400
4401              IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /= building_pars_f%fill )                &
4402                 surf_usm_v(l)%lai(m) = building_pars_f%pars_xy(ind_lai_w,j,i)
4403
4404              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4405                 surf_usm_v(l)%rho_c_wall(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4406                 surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4407              ENDIF
4408
4409
4410              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
4411                 surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4412
4413              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
4414                 surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4415
4416              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4417                 surf_usm_v(l)%rho_c_green(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4418                 surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4419              ENDIF
4420              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
4421                 surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4422
4423              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
4424                 surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4425
4426              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
4427                 surf_usm_v(l)%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4428                 surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4429              ENDIF
4430              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )                  &
4431                 surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4432
4433              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )                  &
4434                 surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4435
4436              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4437                 surf_usm_v(l)%lambda_h(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4438                 surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4439              ENDIF
4440              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
4441                 surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4442
4443              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
4444                 surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4445
4446              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4447                 surf_usm_v(l)%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4448                 surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) =                                      &
4449                 building_pars_f%pars_xy(ind_tc1,j,i)
4450              ENDIF
4451              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
4452                 surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) =                                      &
4453                 building_pars_f%pars_xy(ind_tc2,j,i)
4454
4455              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
4456                 surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) =                                      &
4457                 building_pars_f%pars_xy(ind_tc3,j,i)
4458
4459              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
4460                 surf_usm_v(l)%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4461                 surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) =                                     &
4462                 building_pars_f%pars_xy(ind_tc1,j,i)
4463              ENDIF
4464              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )                  &
4465                 surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) =                                     &
4466                 building_pars_f%pars_xy(ind_tc2,j,i)
4467
4468              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )                  &
4469                 surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) =                                     &
4470                 building_pars_f%pars_xy(ind_tc3,j,i)
4471
4472              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=                   &
4473                   building_pars_f%fill )                                                          &
4474                 surf_usm_v(l)%target_temp_summer(m) =                                             &
4475                 building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)
4476
4477              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=                   &
4478                   building_pars_f%fill )                                                          &
4479                 surf_usm_v(l)%target_temp_winter(m) =                                             &
4480                 building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)
4481
4482              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill )            &
4483                 surf_usm_v(l)%emissivity(m,ind_veg_wall) =                                        &
4484                 building_pars_f%pars_xy(ind_emis_wall,j,i)
4485
4486              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )           &
4487                 surf_usm_v(l)%emissivity(m,ind_pav_green) =                                       &
4488                 building_pars_f%pars_xy(ind_emis_green,j,i)
4489
4490              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )             &
4491                 surf_usm_v(l)%emissivity(m,ind_wat_win)   =                                       &
4492                 building_pars_f%pars_xy(ind_emis_win,j,i)
4493
4494              IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )                &
4495                 surf_usm_v(l)%transmissivity(m) =                                                 &
4496                 building_pars_f%pars_xy(ind_trans,j,i)
4497
4498              IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )                   &
4499                 surf_usm_v(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4500
4501              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                 &
4502                 surf_usm_v(l)%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4503
4504              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )                 &
4505                 surf_usm_v(l)%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4506
4507              IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= building_pars_f%fill )        &
4508                 surf_usm_v(l)%albedo_type(m,ind_veg_wall)  =                                      &
4509                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4510
4511              IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= building_pars_f%fill )       &
4512                 surf_usm_v(l)%albedo_type(m,ind_pav_green) =                                      &
4513                 building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4514
4515              IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= building_pars_f%fill )         &
4516                 surf_usm_v(l)%albedo_type(m,ind_wat_win)   =                                      &
4517                 building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4518
4519              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )         &
4520                 surf_usm_v(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4521
4522              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )         &
4523                 surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4524
4525              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )         &
4526                 surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4527
4528              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )         &
4529                 surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4530
4531              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /= building_pars_f%fill )         &
4532                 surf_usm_v(l)%zw_green(nzb_wall,m) =                                              &
4533                 building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4534
4535              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /= building_pars_f%fill )         &
4536                 surf_usm_v(l)%zw_green(nzb_wall+1,m) =                                            &
4537                 building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4538
4539              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /= building_pars_f%fill )         &
4540                 surf_usm_v(l)%zw_green(nzb_wall+2,m) =                                            &
4541                 building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4542
4543              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /= building_pars_f%fill )         &
4544                 surf_usm_v(l)%zw_green(nzb_wall+3,m) =                                            &
4545                 building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4546
4547           ENDDO
4548        ENDDO
4549     ENDIF
4550!
4551!--  Read building surface pars. If present, they override LOD1-LOD3 building pars where applicable
4552     IF ( building_surface_pars_f%from_file )  THEN
4553        DO  m = 1, surf_usm_h%ns
4554           i = surf_usm_h%i(m)
4555           j = surf_usm_h%j(m)
4556           k = surf_usm_h%k(m)
4557!
4558!--        Iterate over surfaces in column, check height and orientation
4559           DO  is = building_surface_pars_f%index_ji(1,j,i), &
4560                    building_surface_pars_f%index_ji(2,j,i)
4561              IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h%koff .AND.                  &
4562                   building_surface_pars_f%coords(1,is) == k )  THEN
4563
4564                 IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /=                          &
4565                      building_surface_pars_f%fill )                                               &
4566                    surf_usm_h%frac(m,ind_veg_wall) =                                              &
4567                    building_surface_pars_f%pars(ind_s_wall_frac,is)
4568
4569                 IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /=                       &
4570                      building_surface_pars_f%fill )                                               &
4571                    surf_usm_h%frac(m,ind_pav_green) =                                             &
4572                    building_surface_pars_f%pars(ind_s_green_frac_w,is)
4573
4574                 IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /=                       &
4575                      building_surface_pars_f%fill )                                               &
4576                    surf_usm_h%frac(m,ind_pav_green) =                                             &
4577                    building_surface_pars_f%pars(ind_s_green_frac_r,is)
4578                    !TODO clarify: why should _w and _r be on the same surface?
4579
4580                 IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /=                           &
4581                      building_surface_pars_f%fill )                                               &
4582                    surf_usm_h%frac(m,ind_wat_win) = building_surface_pars_f%pars(ind_s_win_frac,is)
4583
4584                 IF ( building_surface_pars_f%pars(ind_s_lai_r,is) /=                              &
4585                      building_surface_pars_f%fill )                                               &
4586                    surf_usm_h%lai(m) = building_surface_pars_f%pars(ind_s_lai_r,is)
4587
4588                 IF ( building_surface_pars_f%pars(ind_s_hc1,is) /=                                &
4589                      building_surface_pars_f%fill )  THEN
4590                    surf_usm_h%rho_c_wall(nzb_wall:nzb_wall+1,m) =                                 &
4591                    building_surface_pars_f%pars(ind_s_hc1,is)
4592                    surf_usm_h%rho_c_green(nzb_wall:nzb_wall+1,m) =                                &
4593                    building_surface_pars_f%pars(ind_s_hc1,is)
4594                    surf_usm_h%rho_c_window(nzb_wall:nzb_wall+1,m) =                               &
4595                    building_surface_pars_f%pars(ind_s_hc1,is)
4596                 ENDIF
4597
4598                 IF ( building_surface_pars_f%pars(ind_s_hc2,is) /=                                &
4599                      building_surface_pars_f%fill )  THEN
4600                    surf_usm_h%rho_c_wall(nzb_wall+2,m) =                                          &
4601                    building_surface_pars_f%pars(ind_s_hc2,is)
4602                    surf_usm_h%rho_c_green(nzb_wall+2,m) =                                         &
4603                    building_surface_pars_f%pars(ind_s_hc2,is)
4604                    surf_usm_h%rho_c_window(nzb_wall+2,m) =                                        &
4605                    building_surface_pars_f%pars(ind_s_hc2,is)
4606                 ENDIF
4607
4608                 IF ( building_surface_pars_f%pars(ind_s_hc3,is) /=                                &
4609                      building_surface_pars_f%fill )  THEN
4610                    surf_usm_h%rho_c_wall(nzb_wall+3,m) =                                          &
4611                    building_surface_pars_f%pars(ind_s_hc3,is)
4612                    surf_usm_h%rho_c_green(nzb_wall+3,m) =                                         &
4613                    building_surface_pars_f%pars(ind_s_hc3,is)
4614                    surf_usm_h%rho_c_window(nzb_wall+3,m) =                                        &
4615                    building_surface_pars_f%pars(ind_s_hc3,is)
4616                 ENDIF
4617
4618                 IF ( building_surface_pars_f%pars(ind_s_tc1,is) /=                                &
4619                      building_surface_pars_f%fill )  THEN
4620                    surf_usm_h%lambda_h(nzb_wall:nzb_wall+1,m) =                                   &
4621                    building_surface_pars_f%pars(ind_s_tc1,is)
4622                    surf_usm_h%lambda_h_green(nzb_wall:nzb_wall+1,m) =                             &
4623                    building_surface_pars_f%pars(ind_s_tc1,is)
4624                    surf_usm_h%lambda_h_window(nzb_wall:nzb_wall+1,m) =                            &
4625                    building_surface_pars_f%pars(ind_s_tc1,is)
4626                 ENDIF
4627
4628                 IF ( building_surface_pars_f%pars(ind_s_tc2,is) /=                                &
4629                      building_surface_pars_f%fill )  THEN
4630                    surf_usm_h%lambda_h(nzb_wall+2,m) =                                            &
4631                    building_surface_pars_f%pars(ind_s_tc2,is)
4632                    surf_usm_h%lambda_h_green(nzb_wall+2,m) =                                      &
4633                    building_surface_pars_f%pars(ind_s_tc2,is)
4634                    surf_usm_h%lambda_h_window(nzb_wall+2,m) =                                     &
4635                    building_surface_pars_f%pars(ind_s_tc2,is)
4636                 ENDIF
4637
4638                 IF ( building_surface_pars_f%pars(ind_s_tc3,is) /=                                &
4639                      building_surface_pars_f%fill )  THEN
4640                    surf_usm_h%lambda_h(nzb_wall+3,m) =                                            &
4641                    building_surface_pars_f%pars(ind_s_tc3,is)
4642                    surf_usm_h%lambda_h_green(nzb_wall+3,m) =                                      &
4643                    building_surface_pars_f%pars(ind_s_tc3,is)
4644                    surf_usm_h%lambda_h_window(nzb_wall+3,m) =                                     &
4645                    building_surface_pars_f%pars(ind_s_tc3,is)
4646                 ENDIF
4647
4648                 IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is) /=          &
4649                      building_surface_pars_f%fill )                                               &
4650                    surf_usm_h%target_temp_summer(m) =                                             &
4651                    building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is)
4652
4653                 IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is) /=          &
4654                      building_surface_pars_f%fill )                                               &
4655                    surf_usm_h%target_temp_winter(m) =                                             &
4656                    building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is)
4657
4658                 IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /=                          &
4659                      building_surface_pars_f%fill )                                               &
4660                    surf_usm_h%emissivity(m,ind_veg_wall) =                                        &
4661                    building_surface_pars_f%pars(ind_s_emis_wall,is)
4662
4663                 IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /=                         &
4664                      building_surface_pars_f%fill )                                               &
4665                    surf_usm_h%emissivity(m,ind_pav_green) =                                       &
4666                    building_surface_pars_f%pars(ind_s_emis_green,is)
4667
4668                 IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /=                           &
4669                      building_surface_pars_f%fill )                                               &
4670                    surf_usm_h%emissivity(m,ind_wat_win) =                                         &
4671                    building_surface_pars_f%pars(ind_s_emis_win,is)
4672
4673                 IF ( building_surface_pars_f%pars(ind_s_trans,is) /=                              &
4674                      building_surface_pars_f%fill )                                               &
4675                    surf_usm_h%transmissivity(m) = building_surface_pars_f%pars(ind_s_trans,is)
4676
4677                 IF ( building_surface_pars_f%pars(ind_s_z0,is) /=                                 &
4678                      building_surface_pars_f%fill )                                               &
4679                    surf_usm_h%z0(m) = building_surface_pars_f%pars(ind_s_z0,is)
4680
4681                 IF ( building_surface_pars_f%pars(ind_s_z0qh,is) /=                               &
4682                      building_surface_pars_f%fill )  THEN
4683                    surf_usm_h%z0q(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
4684                    surf_usm_h%z0h(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
4685                 ENDIF
4686
4687                 EXIT ! Surface was found and processed
4688              ENDIF
4689           ENDDO
4690        ENDDO
4691
4692        DO  l = 0, 3
4693           DO  m = 1, surf_usm_v(l)%ns
4694              i = surf_usm_v(l)%i(m)
4695              j = surf_usm_v(l)%j(m)
4696              k = surf_usm_v(l)%k(m)
4697!
4698!--           Iterate over surfaces in column, check height and orientation
4699              DO  is = building_surface_pars_f%index_ji(1,j,i),                                    &
4700                       building_surface_pars_f%index_ji(2,j,i)
4701                 IF ( building_surface_pars_f%coords(5,is) == -surf_usm_v(l)%joff .AND.            &
4702                      building_surface_pars_f%coords(6,is) == -surf_usm_v(l)%ioff .AND.            &
4703                      building_surface_pars_f%coords(1,is) == k )  THEN
4704
4705                    IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /=                       &
4706                         building_surface_pars_f%fill )                                            &
4707                       surf_usm_v(l)%frac(m,ind_veg_wall) =                                        &
4708                       building_surface_pars_f%pars(ind_s_wall_frac,is)
4709
4710                    IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /=                    &
4711                         building_surface_pars_f%fill )                                            &
4712                       surf_usm_v(l)%frac(m,ind_pav_green) =                                       &
4713                       building_surface_pars_f%pars(ind_s_green_frac_w,is)
4714
4715                    IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /=                    &
4716                         building_surface_pars_f%fill )                                            &
4717                       surf_usm_v(l)%frac(m,ind_pav_green) =                                       &
4718                       building_surface_pars_f%pars(ind_s_green_frac_r,is)
4719                       !TODO Clarify: why should _w and _r be on the same surface?
4720
4721                    IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /=                        &
4722                         building_surface_pars_f%fill )                                            &
4723                       surf_usm_v(l)%frac(m,ind_wat_win) =                                         &
4724                       building_surface_pars_f%pars(ind_s_win_frac,is)
4725
4726                    IF ( building_surface_pars_f%pars(ind_s_lai_r,is) /=                           &
4727                         building_surface_pars_f%fill )                                            &
4728                       surf_usm_v(l)%lai(m) = building_surface_pars_f%pars(ind_s_lai_r,is)
4729
4730                    IF ( building_surface_pars_f%pars(ind_s_hc1,is) /=                             &
4731                         building_surface_pars_f%fill )  THEN
4732                       surf_usm_v(l)%rho_c_wall(nzb_wall:nzb_wall+1,m) =                           &
4733                       building_surface_pars_f%pars(ind_s_hc1,is)
4734                       surf_usm_v(l)%rho_c_green(nzb_wall:nzb_wall+1,m) =                          &
4735                       building_surface_pars_f%pars(ind_s_hc1,is)
4736                       surf_usm_v(l)%rho_c_window(nzb_wall:nzb_wall+1,m) =                         &
4737                       building_surface_pars_f%pars(ind_s_hc1,is)
4738                    ENDIF
4739
4740                    IF ( building_surface_pars_f%pars(ind_s_hc2,is) /=                             &
4741                         building_surface_pars_f%fill )  THEN
4742                       surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) =                                    &
4743                       building_surface_pars_f%pars(ind_s_hc2,is)
4744                       surf_usm_v(l)%rho_c_green(nzb_wall+2,m) =                                   &
4745                       building_surface_pars_f%pars(ind_s_hc2,is)
4746                       surf_usm_v(l)%rho_c_window(nzb_wall+2,m) =                                  &
4747                       building_surface_pars_f%pars(ind_s_hc2,is)
4748                    ENDIF
4749
4750                    IF ( building_surface_pars_f%pars(ind_s_hc3,is) /=                             &
4751                         building_surface_pars_f%fill )  THEN
4752                       surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) =                                    &
4753                       building_surface_pars_f%pars(ind_s_hc3,is)
4754                       surf_usm_v(l)%rho_c_green(nzb_wall+3,m) =                                   &
4755                       building_surface_pars_f%pars(ind_s_hc3,is)
4756                       surf_usm_v(l)%rho_c_window(nzb_wall+3,m) =                                  &
4757                       building_surface_pars_f%pars(ind_s_hc3,is)
4758                    ENDIF
4759
4760                    IF ( building_surface_pars_f%pars(ind_s_tc1,is) /=                             &
4761                         building_surface_pars_f%fill )  THEN
4762                       surf_usm_v(l)%lambda_h(nzb_wall:nzb_wall+1,m) =                             &
4763                       building_surface_pars_f%pars(ind_s_tc1,is)
4764                       surf_usm_v(l)%lambda_h_green(nzb_wall:nzb_wall+1,m) =                       &
4765                       building_surface_pars_f%pars(ind_s_tc1,is)
4766                       surf_usm_v(l)%lambda_h_window(nzb_wall:nzb_wall+1,m) =                      &
4767                       building_surface_pars_f%pars(ind_s_tc1,is)
4768                    ENDIF
4769
4770                    IF ( building_surface_pars_f%pars(ind_s_tc2,is) /=                             &
4771                         building_surface_pars_f%fill )  THEN
4772                       surf_usm_v(l)%lambda_h(nzb_wall+2,m) =                                      &
4773                       building_surface_pars_f%pars(ind_s_tc2,is)
4774                       surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) =                                &
4775                       building_surface_pars_f%pars(ind_s_tc2,is)
4776                       surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) =                               &
4777                       building_surface_pars_f%pars(ind_s_tc2,is)
4778                    ENDIF
4779
4780                    IF ( building_surface_pars_f%pars(ind_s_tc3,is) /=                             &
4781                         building_surface_pars_f%fill )  THEN
4782                       surf_usm_v(l)%lambda_h(nzb_wall+3,m) =                                      &
4783                       building_surface_pars_f%pars(ind_s_tc3,is)
4784                       surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) =                                &
4785                       building_surface_pars_f%pars(ind_s_tc3,is)
4786                       surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) =                               &
4787                       building_surface_pars_f%pars(ind_s_tc3,is)
4788                    ENDIF
4789
4790                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is) /=       &
4791                         building_surface_pars_f%fill )                                            &
4792                       surf_usm_v(l)%target_temp_summer(m) =                                       &
4793                       building_surface_pars_f%pars(ind_s_indoor_target_temp_summer,is)
4794
4795                    IF ( building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is) /=       &
4796                         building_surface_pars_f%fill )                                            &
4797                       surf_usm_v(l)%target_temp_winter(m) =                                       &
4798                       building_surface_pars_f%pars(ind_s_indoor_target_temp_winter,is)
4799
4800                    IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /=                       &
4801                         building_surface_pars_f%fill )                                            &
4802                       surf_usm_v(l)%emissivity(m,ind_veg_wall) =                                  &
4803                       building_surface_pars_f%pars(ind_s_emis_wall,is)
4804
4805                    IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /=                      &
4806                         building_surface_pars_f%fill )                                            &
4807                       surf_usm_v(l)%emissivity(m,ind_pav_green) =                                 &
4808                       building_surface_pars_f%pars(ind_s_emis_green,is)
4809
4810                    IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /=                        &
4811                         building_surface_pars_f%fill )                                            &
4812                       surf_usm_v(l)%emissivity(m,ind_wat_win) =                                   &
4813                       building_surface_pars_f%pars(ind_s_emis_win,is)
4814
4815                    IF ( building_surface_pars_f%pars(ind_s_trans,is) /=                           &
4816                         building_surface_pars_f%fill )                                            &
4817                       surf_usm_v(l)%transmissivity(m) =                                           &
4818                       building_surface_pars_f%pars(ind_s_trans,is)
4819
4820                    IF ( building_surface_pars_f%pars(ind_s_z0,is) /=                              &
4821                         building_surface_pars_f%fill )                                            &
4822                       surf_usm_v(l)%z0(m) = building_surface_pars_f%pars(ind_s_z0,is)
4823
4824                    IF ( building_surface_pars_f%pars(ind_s_z0qh,is) /=                            &
4825                         building_surface_pars_f%fill )  THEN
4826                       surf_usm_v(l)%z0q(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
4827                       surf_usm_v(l)%z0h(m) = building_surface_pars_f%pars(ind_s_z0qh,is)
4828                    ENDIF
4829
4830                    EXIT ! Surface was found and processed
4831                 ENDIF
4832              ENDDO
4833           ENDDO
4834        ENDDO
4835     ENDIF
4836!
4837!--    Initialize albedo type via given type from static input file. Please note, even though
4838!--    the albedo type has been already given by the pars, albedo_type overwrites these values.
4839       IF ( albedo_type_f%from_file )  THEN
4840          DO  m = 1, surf_usm_h%ns
4841             i = surf_usm_h%i(m)
4842             j = surf_usm_h%j(m)
4843             IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                                   &
4844                surf_usm_h%albedo_type(m,:) = albedo_type_f%var(j,i)
4845          ENDDO
4846          DO  l = 0, 3
4847             DO  m = 1, surf_usm_v(l)%ns
4848                i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4849                j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4850
4851                IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )                                &
4852                   surf_usm_v(l)%albedo_type(m,:) = albedo_type_f%var(j,i)
4853             ENDDO
4854          ENDDO
4855       ENDIF
4856!
4857!--  Run further checks to ensure that the respecitve material fractions are prescribed properly.
4858!--  Start with horizontal surfaces (roofs).
4859     relative_fractions_corrected = .FALSE.
4860     DO  m = 1, surf_usm_h%ns
4861        sum_frac = SUM( surf_usm_h%frac(m,:) )
4862        IF ( sum_frac /= 1.0_wp )  THEN
4863           relative_fractions_corrected = .TRUE.
4864!
4865!--        Normalize relative fractions to 1. Deviations from 1 can arise, e.g. by rounding errors
4866!--        but also by inconsistent driver creation.
4867           IF ( sum_frac /= 0.0_wp )  THEN
4868              surf_usm_h%frac(m,:) = surf_usm_h%frac(m,:) / sum_frac
4869!
4870!--        In case all relative fractions are erroneously set to zero, set wall fraction to 1.
4871           ELSE
4872              surf_usm_h%frac(m,ind_veg_wall)  = 1.0_wp
4873              surf_usm_h%frac(m,ind_wat_win)   = 0.0_wp
4874              surf_usm_h%frac(m,ind_pav_green) = 0.0_wp
4875           ENDIF
4876        ENDIF
4877     ENDDO
4878!
4879!--  If fractions were normalized, give an informative message.
4880#if defined( __parallel )
4881     CALL MPI_ALLREDUCE( MPI_IN_PLACE, relative_fractions_corrected, 1,                            &
4882                         MPI_LOGICAL, MPI_LOR, comm2d, ierr )
4883#endif
4884     IF ( relative_fractions_corrected )  THEN
4885        message_string = 'At some horizotal surfaces the relative material fractions do not ' //   &
4886                         'sum-up to one . Hence, the respective fractions were normalized.'
4887        CALL message( 'urban_surface_model_mod', 'PA0686', 0, 0, 0, 6, 0 )
4888     ENDIF
4889!
4890!--  Check relative fractions at vertical surfaces.
4891     relative_fractions_corrected = .FALSE.
4892     DO  l = 0, 3
4893        DO  m = 1, surf_usm_v(l)%ns
4894           sum_frac = SUM( surf_usm_v(l)%frac(m,:) )
4895           IF ( sum_frac /= 1.0_wp )  THEN
4896              relative_fractions_corrected = .TRUE.
4897!
4898!--           Normalize relative fractions to 1.
4899              IF ( sum_frac /= 0.0_wp )  THEN
4900                 surf_usm_v(l)%frac(m,:) = surf_usm_v(l)%frac(m,:) / sum_frac
4901!
4902!--           In case all relative fractions are erroneously set to zero, set wall fraction to 1.
4903              ELSE
4904                 surf_usm_v(l)%frac(m,ind_veg_wall)  = 1.0_wp
4905                 surf_usm_v(l)%frac(m,ind_wat_win)   = 0.0_wp
4906                 surf_usm_v(l)%frac(m,ind_pav_green) = 0.0_wp
4907              ENDIF
4908           ENDIF
4909        ENDDO
4910     ENDDO
4911!
4912!--  Also here, if fractions were normalized, give an informative message.
4913#if defined( __parallel )
4914     CALL MPI_ALLREDUCE( MPI_IN_PLACE, relative_fractions_corrected, 1,                            &
4915                         MPI_LOGICAL, MPI_LOR, comm2d, ierr )
4916#endif
4917     IF ( relative_fractions_corrected )  THEN
4918        message_string = 'At some vertical surfaces the relative material fractions do not ' //    &
4919                         'sum-up to one . Hence, the respective fractions were normalized.'
4920        CALL message( 'urban_surface_model_mod', 'PA0686', 0, 0, 0, 6, 0 )
4921     ENDIF
4922!
4923!--  Read the surface_types array.
4924!--  Please note, here also initialization of surface attributes is done as long as _urbsurf and
4925!--  _surfpar files are available. Values from above will be overwritten. This might be removed
4926!--  later, but is still in the code to enable compatibility with older model version.
4927     CALL usm_read_urban_surface_types()
4928
4929     CALL usm_init_material_model()
4930
4931!--  Init skin layer properties (can be done after initialization of wall layers)
4932
4933     DO  m = 1, surf_usm_h%ns
4934        i = surf_usm_h%i(m)
4935        j = surf_usm_h%j(m)
4936
4937         surf_usm_h%c_surface(m)           = surf_usm_h%rho_c_wall(nzb_wall,m) *                   &
4938                                             surf_usm_h%dz_wall(nzb_wall,m) * 0.25_wp
4939         surf_usm_h%lambda_surf(m)         = surf_usm_h%lambda_h(nzb_wall,m) *                     &
4940                                             surf_usm_h%ddz_wall(nzb_wall,m) * 2.0_wp
4941         surf_usm_h%c_surface_green(m)     = surf_usm_h%rho_c_wall(nzb_wall,m) *                   &
4942                                             surf_usm_h%dz_wall(nzb_wall,m) * 0.25_wp
4943         surf_usm_h%lambda_surf_green(m)   = surf_usm_h%lambda_h_green(nzb_wall,m) *               &
4944                                             surf_usm_h%ddz_green(nzb_wall,m) * 2.0_wp
4945         surf_usm_h%c_surface_window(m)    = surf_usm_h%rho_c_window(nzb_wall,m) *                 &
4946                                             surf_usm_h%dz_window(nzb_wall,m) * 0.25_wp
4947         surf_usm_h%lambda_surf_window(m)  = surf_usm_h%lambda_h_window(nzb_wall,m) *              &
4948                                             surf_usm_h%ddz_window(nzb_wall,m) * 2.0_wp
4949     ENDDO
4950
4951     DO  l = 0, 3
4952         DO  m = 1, surf_usm_v(l)%ns
4953            i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4954            j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4955
4956             surf_usm_v(l)%c_surface(m) = surf_usm_v(l)%rho_c_wall(nzb_wall,m) *                   &
4957                                          surf_usm_v(l)%dz_wall(nzb_wall,m) * 0.25_wp
4958             surf_usm_v(l)%lambda_surf(m) = surf_usm_v(l)%lambda_h(nzb_wall,m) *                   &
4959                                            surf_usm_v(l)%ddz_wall(nzb_wall,m) * 2.0_wp
4960             surf_usm_v(l)%c_surface_green(m) = surf_usm_v(l)%rho_c_green(nzb_wall,m) *            &
4961                                                surf_usm_v(l)%dz_green(nzb_wall,m) * 0.25_wp
4962             surf_usm_v(l)%lambda_surf_green(m) = surf_usm_v(l)%lambda_h_green(nzb_wall,m) *       &
4963                                                  surf_usm_v(l)%ddz_green(nzb_wall,m) * 2.0_wp
4964             surf_usm_v(l)%c_surface_window(m) = surf_usm_v(l)%rho_c_window(nzb_wall,m) *          &
4965                                                    surf_usm_v(l)%dz_window(nzb_wall,m) * 0.25_wp
4966             surf_usm_v(l)%lambda_surf_window(m) = surf_usm_v(l)%lambda_h_window(nzb_wall,m) *     &
4967                                                    surf_usm_v(l)%ddz_window(nzb_wall,m) * 2.0_wp
4968         ENDDO
4969     ENDDO
4970
4971!
4972!--  Init anthropogenic sources of heat
4973     IF ( usm_anthropogenic_heat )  THEN
4974!
4975!--      Init anthropogenic sources of heat (from transportation for now)
4976         CALL usm_read_anthropogenic_heat()
4977     ENDIF
4978
4979!
4980!-- Check for consistent initialization.
4981!-- Check if roughness length for momentum, or heat, exceed surface-layer height and decrease local
4982!-- roughness length where necessary.
4983    DO  m = 1, surf_usm_h%ns
4984       IF ( surf_usm_h%z0(m) >= surf_usm_h%z_mo(m) )  THEN
4985
4986          surf_usm_h%z0(m) = 0.9_wp * surf_usm_h%z_mo(m)
4987
4988          WRITE( message_string, * ) 'z0 exceeds surface-layer height at horizontal urban ' //     &
4989                                     'surface and is decreased appropriately at grid point ' //    &
4990                                     '(i,j) = ',  surf_usm_h%i(m), surf_usm_h%j(m)
4991          CALL message( 'urban_surface_model_mod', 'PA0503', 0, 0, myid, 6, 0 )
4992       ENDIF
4993       IF ( surf_usm_h%z0h(m) >= surf_usm_h%z_mo(m) )  THEN
4994
4995          surf_usm_h%z0h(m) = 0.9_wp * surf_usm_h%z_mo(m)
4996          surf_usm_h%z0q(m) = 0.9_wp * surf_usm_h%z_mo(m)
4997
4998          WRITE( message_string, * ) 'z0h exceeds surface-layer height at horizontal urban ' //    &
4999                                     'surface and is decreased appropriately at grid point ' //    &
5000                                     '(i,j) = ', surf_usm_h%i(m), surf_usm_h%j(m)
5001          CALL message( 'urban_surface_model_mod', 'PA0507', 0, 0, myid, 6, 0 )
5002       ENDIF
5003    ENDDO
5004
5005    DO  l = 0, 3
5006       DO  m = 1, surf_usm_v(l)%ns
5007          IF ( surf_usm_v(l)%z0(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5008
5009             surf_usm_v(l)%z0(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5010
5011             WRITE( message_string, * ) 'z0 exceeds surface-layer height at vertical urban ' //    &
5012                                        'surface and is decreased appropriately at grid point ' // &
5013                                        '(i,j) = ', surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,         &
5014                                         surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5015             CALL message( 'urban_surface_model_mod', 'PA0503', 0, 0, myid, 6, 0 )
5016          ENDIF
5017          IF ( surf_usm_v(l)%z0h(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5018
5019             surf_usm_v(l)%z0h(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5020             surf_usm_v(l)%z0q(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5021
5022             WRITE( message_string, * ) 'z0h exceeds surface-layer height at vertical urban ' //   &
5023                                        'surface and is decreased appropriately at grid point ' // &
5024                                        '(i,j) = ', surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,         &
5025                                        surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5026             CALL message( 'urban_surface_model_mod', 'PA0507', 0, 0, myid, 6, 0 )
5027          ENDIF
5028       ENDDO
5029    ENDDO
5030!
5031!--  Intitialization of the surface and wall/ground/roof temperature
5032!
5033!--  Initialization for restart runs
5034     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
5035
5036!
5037!--     At horizontal surfaces. Please note, t_surf_wall_h is defined on a different data type,
5038!--     but with the same dimension.
5039         DO  m = 1, surf_usm_h%ns
5040            i = surf_usm_h%i(m)
5041            j = surf_usm_h%j(m)
5042            k = surf_usm_h%k(m)
5043
5044            t_surf_wall_h(m) = pt(k,j,i) * exner(k)
5045            t_surf_window_h(m) = pt(k,j,i) * exner(k)
5046            t_surf_green_h(m) = pt(k,j,i) * exner(k)
5047            surf_usm_h%pt_surface(m) = pt(k,j,i) * exner(k)
5048         ENDDO
5049!
5050!--      At vertical surfaces.
5051         DO  l = 0, 3
5052            DO  m = 1, surf_usm_v(l)%ns
5053               i = surf_usm_v(l)%i(m)
5054               j = surf_usm_v(l)%j(m)
5055               k = surf_usm_v(l)%k(m)
5056
5057               t_surf_wall_v(l)%t(m) = pt(k,j,i) * exner(k)
5058               t_surf_window_v(l)%t(m) = pt(k,j,i) * exner(k)
5059               t_surf_green_v(l)%t(m) = pt(k,j,i) * exner(k)
5060               surf_usm_v(l)%pt_surface(m) = pt(k,j,i) * exner(k)
5061            ENDDO
5062         ENDDO
5063
5064!
5065!--      For the sake of correct initialization, set also q_surface.
5066!--      Note, at urban surfaces q_surface is initialized with 0.
5067         IF ( humidity )  THEN
5068            DO  m = 1, surf_usm_h%ns
5069               surf_usm_h%q_surface(m) = 0.0_wp
5070            ENDDO
5071            DO  l = 0, 3
5072               DO  m = 1, surf_usm_v(l)%ns
5073                  surf_usm_v(l)%q_surface(m) = 0.0_wp
5074               ENDDO
5075            ENDDO
5076         ENDIF
5077!
5078!--      Initial values for t_wall
5079!--      Outer value is set to surface temperature, inner value is set to wall_inner_temperature
5080!--      and profile is logaritmic (linear in nz).
5081!--      Horizontal surfaces
5082         DO  m = 1, surf_usm_h%ns
5083!
5084!--         Roof
5085            IF ( surf_usm_h%isroof_surf(m) )  THEN
5086                tin = roof_inner_temperature
5087                twin = window_inner_temperature
5088!
5089!--         Normal land surface
5090            ELSE
5091                tin = soil_inner_temperature
5092                twin = window_inner_temperature
5093            ENDIF
5094
5095            DO k = nzb_wall, nzt_wall+1
5096                c = REAL( k - nzb_wall, wp ) / REAL( nzt_wall + 1 - nzb_wall , wp )
5097
5098                t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_wall_h(m) + c * tin
5099                t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
5100                t_green_h(k,m) = t_surf_wall_h(m)
5101                swc_h(k,m) = 0.5_wp
5102                swc_sat_h(k,m) = 0.95_wp
5103                swc_res_h(k,m) = 0.05_wp
5104                rootfr_h(k,m) = 0.1_wp
5105                wilt_h(k,m) = 0.1_wp
5106                fc_h(k,m) = 0.9_wp
5107            ENDDO
5108         ENDDO
5109!
5110!--      Vertical surfaces
5111         DO  l = 0, 3
5112            DO  m = 1, surf_usm_v(l)%ns
5113!
5114!--            Inner wall
5115               tin = wall_inner_temperature
5116               twin = window_inner_temperature
5117
5118               DO k = nzb_wall, nzt_wall+1
5119                  c = REAL( k - nzb_wall, wp ) / REAL( nzt_wall + 1 - nzb_wall , wp )
5120                  t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_wall_v(l)%t(m) + c * tin
5121                  t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
5122                  t_green_v(l)%t(k,m) = t_surf_wall_v(l)%t(m)
5123               ENDDO
5124            ENDDO
5125         ENDDO
5126     ENDIF
5127
5128!
5129!--  If specified, replace constant wall temperatures with fully 3D values from file
5130     IF ( read_wall_temp_3d )  CALL usm_read_wall_temperature()
5131
5132!--
5133!--  Possibly DO user-defined actions (e.g. define heterogeneous wall surface)
5134     CALL user_init_urban_surface
5135
5136!
5137!--  Initialize prognostic values for the first timestep
5138     t_surf_wall_h_p = t_surf_wall_h
5139     t_surf_wall_v_p = t_surf_wall_v
5140     t_surf_window_h_p = t_surf_window_h
5141     t_surf_window_v_p = t_surf_window_v
5142     t_surf_green_h_p = t_surf_green_h
5143     t_surf_green_v_p = t_surf_green_v
5144
5145     t_wall_h_p = t_wall_h
5146     t_wall_v_p = t_wall_v
5147     t_window_h_p = t_window_h
5148     t_window_v_p = t_window_v
5149     t_green_h_p = t_green_h
5150     t_green_v_p = t_green_v
5151
5152!
5153!-- Set initial values for prognostic soil quantities
5154    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
5155       m_liq_usm_h%var_usm_1d  = 0.0_wp
5156    ENDIF
5157    m_liq_usm_h_p = m_liq_usm_h
5158!
5159!-- Set initial values for prognostic quantities
5160!-- Horizontal surfaces
5161    surf_usm_h%c_liq     = 0.0_wp
5162    surf_usm_h%qsws_liq  = 0.0_wp
5163    surf_usm_h%qsws_veg  = 0.0_wp
5164
5165!
5166!-- Do the same for vertical surfaces
5167    DO  l = 0, 3
5168       surf_usm_v(l)%c_liq     = 0.0_wp
5169       surf_usm_v(l)%qsws_liq  = 0.0_wp
5170       surf_usm_v(l)%qsws_veg  = 0.0_wp
5171    ENDDO
5172
5173
5174
5175    CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
5176
5177    IF ( debug_output )  CALL debug_message( 'usm_init', 'end' )
5178
5179 END SUBROUTINE usm_init
5180
5181
5182!--------------------------------------------------------------------------------------------------!
5183! Description:
5184! ------------
5185!
5186!> Wall model as part of the urban surface model. The model predicts vertical and horizontal
5187!> wall / roof temperatures and window layer temperatures. No window layer temperature calculactions
5188!> during spinup to increase possible timestep.
5189!--------------------------------------------------------------------------------------------------!
5190 SUBROUTINE usm_material_heat_model( during_spinup )
5191
5192
5193    IMPLICIT NONE
5194
5195    INTEGER(iwp)  ::  i,j,k,l,kw, m  !< running indices
5196
5197    LOGICAL  ::  during_spinup  !< if true, no calculation of window temperatures
5198
5199    REAL(wp)  ::  win_absorp  !< absorption coefficient from transmissivity
5200
5201    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  wall_mod        !<
5202    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  wtend, wintend  !< tendency
5203
5204
5205
5206    IF ( debug_output_timestep )  THEN
5207       WRITE( debug_string, * ) 'usm_material_heat_model | during_spinup: ', during_spinup
5208       CALL debug_message( debug_string, 'start' )
5209    ENDIF
5210
5211    !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
5212    wall_mod=1.0_wp
5213    IF ( usm_wall_mod  .AND.  during_spinup )  THEN
5214       DO  kw=nzb_wall, nzb_wall+1
5215          wall_mod(kw) = 0.1_wp
5216       ENDDO
5217    ENDIF
5218
5219!
5220!-- For horizontal surfaces
5221    !$OMP DO SCHEDULE (STATIC)
5222    DO  m = 1, surf_usm_h%ns
5223!
5224!--    Obtain indices
5225       i = surf_usm_h%i(m)
5226       j = surf_usm_h%j(m)
5227       k = surf_usm_h%k(m)
5228!
5229!--    Prognostic equation for ground/roof temperature t_wall_h
5230       wtend(:) = 0.0_wp
5231       wtend(nzb_wall) = ( 1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m) )                            &
5232                          * ( surf_usm_h%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)                 &
5233                              * ( t_wall_h(nzb_wall+1,m) - t_wall_h(nzb_wall,m) )                  &
5234                              * surf_usm_h%ddz_wall(nzb_wall+1,m)                                  &
5235                              + surf_usm_h%frac(m,ind_veg_wall)                                    &
5236                              / ( surf_usm_h%frac(m,ind_veg_wall)                                  &
5237                                  + surf_usm_h%frac(m,ind_pav_green) )                             &
5238                              * surf_usm_h%wghf_eb(m)                                              &
5239                              - surf_usm_h%frac(m,ind_pav_green)                                   &
5240                              / ( surf_usm_h%frac(m,ind_veg_wall)                                  &
5241                                  + surf_usm_h%frac(m,ind_pav_green) )                             &
5242                              * ( surf_usm_h%lambda_h_green(nzt_wall,m)                            &
5243                              * wall_mod(nzt_wall)                                                 &
5244                              * surf_usm_h%ddz_green(nzt_wall,m)                                   &
5245                              + surf_usm_h%lambda_h(nzb_wall,m)                                    &
5246                              * wall_mod(nzb_wall)                                                 &
5247                              * surf_usm_h%ddz_wall(nzb_wall,m) )                                  &
5248                              / ( surf_usm_h%ddz_green(nzt_wall,m)                                 &
5249                              + surf_usm_h%ddz_wall(nzb_wall,m) )                                  &
5250                              * ( t_wall_h(nzb_wall,m) - t_green_h(nzt_wall,m) )                   &
5251                            ) * surf_usm_h%ddz_wall_stag(nzb_wall,m)
5252!
5253!-- If indoor model is used inner wall layer is calculated by using iwghf (indoor wall ground heat flux)
5254       IF ( indoor_model )  THEN
5255          DO  kw = nzb_wall+1, nzt_wall-1
5256             wtend(kw) = ( 1.0_wp / surf_usm_h%rho_c_wall(kw,m) )                                  &
5257                         * ( surf_usm_h%lambda_h(kw,m)                                             &
5258                             * wall_mod(kw)                                                        &
5259                             * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )                               &
5260                             * surf_usm_h%ddz_wall(kw+1,m)                                         &
5261                             - surf_usm_h%lambda_h(kw-1,m)                                         &
5262                             * wall_mod(kw-1)                                                      &
5263                             * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )                               &
5264                             * surf_usm_h%ddz_wall(kw,m)                                           &
5265                           ) * surf_usm_h%ddz_wall_stag(kw,m)
5266          ENDDO
5267          wtend(nzt_wall) = ( 1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m) )                         &
5268                            * ( -surf_usm_h%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)          &
5269                                * ( t_wall_h(nzt_wall,m) - t_wall_h(nzt_wall-1,m) )                &
5270                                * surf_usm_h%ddz_wall(nzt_wall,m)                                  &
5271                                + surf_usm_h%iwghf_eb(m)                                           &
5272                              ) * surf_usm_h%ddz_wall_stag(nzt_wall,m)
5273       ELSE
5274          DO  kw = nzb_wall+1, nzt_wall
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)                                          &
5280                            * wall_mod(kw-1)                                                       &
5281                            * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )                                &
5282                            * surf_usm_h%ddz_wall(kw,m)                                            &
5283                          ) * surf_usm_h%ddz_wall_stag(kw,m)
5284          ENDDO
5285       ENDIF
5286
5287       t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m) + dt_3d                     &
5288                                         * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3)            &
5289                                             * surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )
5290
5291!
5292!-- During spinup the tempeature inside window layers is not calculated to make larger timesteps possible
5293       IF ( .NOT. during_spinup )  THEN
5294          win_absorp = -log( surf_usm_h%transmissivity(m) ) / surf_usm_h%zw_window(nzt_wall,m)
5295!
5296!--       Prognostic equation for ground/roof window temperature t_window_h takes absorption of
5297!--       shortwave radiation into account
5298          wintend(:) = 0.0_wp
5299          wintend(nzb_wall) = ( 1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m) ) *                   &
5300                              ( surf_usm_h%lambda_h_window(nzb_wall,m)                             &
5301                                * ( t_window_h(nzb_wall+1,m) - t_window_h(nzb_wall,m) )            &
5302                                * surf_usm_h%ddz_window(nzb_wall+1,m)                              &
5303                                + surf_usm_h%wghf_eb_window(m)                                     &
5304                                + surf_usm_h%rad_sw_in(m)                                          &
5305                                * ( 1.0_wp - exp( -win_absorp * surf_usm_h%zw_window(nzb_wall,m) ) ) &
5306                              ) * surf_usm_h%ddz_window_stag(nzb_wall,m)
5307
5308          IF ( indoor_model ) THEN
5309             DO  kw = nzb_wall+1, nzt_wall-1
5310                wintend(kw) = ( 1.0_wp / surf_usm_h%rho_c_window(kw,m) )                           &
5311                              * ( surf_usm_h%lambda_h_window(kw,m)                                 &
5312                                  * ( t_window_h(kw+1,m) - t_window_h(kw,m) )                      &
5313                                  * surf_usm_h%ddz_window(kw+1,m)                                  &
5314                                  - surf_usm_h%lambda_h_window(kw-1,m)                             &
5315                                 * ( t_window_h(kw,m) - t_window_h(kw-1,m) )                       &
5316                                 * surf_usm_h%ddz_window(kw,m)                                     &
5317                                 + surf_usm_h%rad_sw_in(m)                                         &
5318                                 * ( exp( -win_absorp * surf_usm_h%zw_window(kw-1,m) )             &
5319                                     - exp(-win_absorp * surf_usm_h%zw_window(kw,m) )              &
5320                                   )                                                               &
5321                                 ) * surf_usm_h%ddz_window_stag(kw,m)
5322
5323             ENDDO
5324             wintend(nzt_wall) = ( 1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m) )                  &
5325                                 * ( -surf_usm_h%lambda_h_window(nzt_wall-1,m)                     &
5326                                    * ( t_window_h(nzt_wall,m) - t_window_h(nzt_wall-1,m) )        &
5327                                    * surf_usm_h%ddz_window(nzt_wall,m)                            &
5328                                    + surf_usm_h%iwghf_eb_window(m)                                &
5329                                    + surf_usm_h%rad_sw_in(m)                                      &
5330                                    * ( exp( -win_absorp * surf_usm_h%zw_window(nzt_wall-1,m) )    &
5331                                        - exp( -win_absorp * surf_usm_h%zw_window(nzt_wall,m) )    &
5332                                      )                                                            &
5333                                    ) * surf_usm_h%ddz_window_stag(nzt_wall,m)
5334          ELSE
5335             DO  kw = nzb_wall+1, nzt_wall
5336                wintend(kw) = ( 1.0_wp / surf_usm_h%rho_c_window(kw,m) )                           &
5337                              * ( surf_usm_h%lambda_h_window(kw,m)                                 &
5338                                  * ( t_window_h(kw+1,m) - t_window_h(kw,m) )                      &
5339                                  * surf_usm_h%ddz_window(kw+1,m)                                  &
5340                                  - surf_usm_h%lambda_h_window(kw-1,m)                             &
5341                                  * ( t_window_h(kw,m)                                             &
5342                                  - t_window_h(kw-1,m) )                                           &
5343                                  * surf_usm_h%ddz_window(kw,m) + surf_usm_h%rad_sw_in(m)          &
5344                                   * ( exp( -win_absorp * surf_usm_h%zw_window(kw-1,m) )           &
5345                                       - exp(-win_absorp * surf_usm_h%zw_window(kw,m) )            &
5346                                     )                                                             &
5347                                 ) * surf_usm_h%ddz_window_stag(kw,m)
5348
5349             ENDDO
5350          ENDIF
5351
5352          t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m) + dt_3d              &
5353                                              * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3)     &
5354                                                  * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )
5355
5356       ENDIF
5357
5358!
5359!--    Calculate t_wall tendencies for the next Runge-Kutta step
5360       IF ( timestep_scheme(1:5) == 'runge' )  THEN
5361           IF ( intermediate_timestep_count == 1 )  THEN
5362              DO  kw = nzb_wall, nzt_wall
5363                 surf_usm_h%tt_wall_m(kw,m) = wtend(kw)
5364              ENDDO
5365           ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
5366               DO  kw = nzb_wall, nzt_wall
5367                  surf_usm_h%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +                            &
5368                                               5.3125_wp * surf_usm_h%tt_wall_m(kw,m)
5369               ENDDO
5370           ENDIF
5371       ENDIF
5372
5373       IF ( .NOT. during_spinup )  THEN
5374!
5375!--       Calculate t_window tendencies for the next Runge-Kutta step
5376          IF ( timestep_scheme(1:5) == 'runge' )  THEN
5377              IF ( intermediate_timestep_count == 1 )  THEN
5378                 DO  kw = nzb_wall, nzt_wall
5379                    surf_usm_h%tt_window_m(kw,m) = wintend(kw)
5380                 ENDDO
5381              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
5382                  DO  kw = nzb_wall, nzt_wall
5383                     surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +                     &
5384                                                    5.3125_wp * surf_usm_h%tt_window_m(kw,m)
5385                  ENDDO
5386              ENDIF
5387          ENDIF
5388       ENDIF
5389
5390    ENDDO
5391
5392!
5393!-- For vertical surfaces
5394    !$OMP DO SCHEDULE (STATIC)
5395    DO  l = 0, 3
5396       DO  m = 1, surf_usm_v(l)%ns
5397!
5398!--       Obtain indices
5399          i = surf_usm_v(l)%i(m)
5400          j = surf_usm_v(l)%j(m)
5401          k = surf_usm_v(l)%k(m)
5402!
5403!--       Prognostic equation for wall temperature t_wall_v
5404          wtend(:) = 0.0_wp
5405
5406          wtend(nzb_wall) = ( 1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m) )                      &
5407                            * ( surf_usm_v(l)%lambda_h(nzb_wall,m)                                 &
5408                                * wall_mod(nzb_wall)                                               &
5409                                * ( t_wall_v(l)%t(nzb_wall+1,m)                                    &
5410                                - t_wall_v(l)%t(nzb_wall,m) )                                      &
5411                                * surf_usm_v(l)%ddz_wall(nzb_wall+1,m)                             &
5412                                + surf_usm_v(l)%frac(m,ind_veg_wall)                               &
5413                                / (surf_usm_v(l)%frac(m,ind_veg_wall)                              &
5414                                + surf_usm_v(l)%frac(m,ind_pav_green) )                            &
5415                                * surf_usm_v(l)%wghf_eb(m)                                         &
5416                                - surf_usm_v(l)%frac(m,ind_pav_green)                              &
5417                                / (surf_usm_v(l)%frac(m,ind_veg_wall)                              &
5418                                + surf_usm_v(l)%frac(m,ind_pav_green) )                            &
5419                                * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m)                       &
5420                                * wall_mod(nzt_wall)                                               &
5421                                * surf_usm_v(l)%ddz_green(nzt_wall,m)                              &
5422                                + surf_usm_v(l)%lambda_h(nzb_wall,m)                               &
5423                                * wall_mod(nzb_wall)                                               &
5424                                * surf_usm_v(l)%ddz_wall(nzb_wall,m) )                             &
5425                                / ( surf_usm_v(l)%ddz_green(nzt_wall,m)                            &
5426                                + surf_usm_v(l)%ddz_wall(nzb_wall,m) )                             &
5427                                * ( t_wall_v(l)%t(nzb_wall,m)                                      &
5428                                - t_green_v(l)%t(nzt_wall,m) )                                     &
5429                              ) * surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
5430
5431          IF ( indoor_model )  THEN
5432             DO  kw = nzb_wall+1, nzt_wall-1
5433                wtend(kw) = ( 1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m) )                            &
5434                          * ( surf_usm_v(l)%lambda_h(kw,m)  * wall_mod(kw)                         &
5435                              * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )                    &
5436                              * surf_usm_v(l)%ddz_wall(kw+1,m)                                     &
5437                              - surf_usm_v(l)%lambda_h(kw-1,m)                                     &
5438                              * wall_mod(kw-1)                                                     &
5439                              * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )                    &
5440                              * surf_usm_v(l)%ddz_wall(kw,m)                                       &
5441                            ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5442             ENDDO
5443             wtend(nzt_wall) = ( 1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m) )                   &
5444                               * ( -surf_usm_v(l)%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)    &
5445                                   * ( t_wall_v(l)%t(nzt_wall,m) - t_wall_v(l)%t(nzt_wall-1,m) )   &
5446                                   * surf_usm_v(l)%ddz_wall(nzt_wall,m)                            &
5447                                   + surf_usm_v(l)%iwghf_eb(m)                                     &
5448                                 ) * surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
5449          ELSE
5450             DO  kw = nzb_wall+1, nzt_wall
5451                 wtend(kw) = ( 1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m) )                           &
5452                             * ( surf_usm_v(l)%lambda_h(kw,m) * wall_mod(kw)                       &
5453                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )                 &
5454                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                                  &
5455                                 - surf_usm_v(l)%lambda_h(kw-1,m)                                  &
5456                                 * wall_mod(kw-1)                                                  &
5457                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )                 &
5458                                 * surf_usm_v(l)%ddz_wall(kw,m)                                    &
5459                               ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5460             ENDDO
5461          ENDIF
5462
5463          t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) =  t_wall_v(l)%t(nzb_wall:nzt_wall,m) + dt_3d       &
5464                                                  * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3)   &
5465                                                      * surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall, &
5466                                                      m) )
5467
5468          IF ( .NOT. during_spinup )  THEN
5469             win_absorp = -log( surf_usm_v(l)%transmissivity(m) ) /                                &
5470                          surf_usm_v(l)%zw_window(nzt_wall,m)
5471!
5472!--          Prognostic equation for window temperature t_window_v
5473             wintend(:) = 0.0_wp
5474             wintend(nzb_wall) = ( 1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m) )               &
5475                                 * ( surf_usm_v(l)%lambda_h_window(nzb_wall,m)                     &
5476                                     * ( t_window_v(l)%t(nzb_wall+1,m)                             &
5477                                     - t_window_v(l)%t(nzb_wall,m) )                               &
5478                                     * surf_usm_v(l)%ddz_window(nzb_wall+1,m)                      &
5479                                     + surf_usm_v(l)%wghf_eb_window(m)                             &
5480                                     + surf_usm_v(l)%rad_sw_in(m)                                  &
5481                                     * ( 1.0_wp - exp( -win_absorp                                 &
5482                                         * surf_usm_v(l)%zw_window(nzb_wall,m) ) )                 &
5483                                   ) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
5484
5485             IF ( indoor_model ) THEN
5486                DO  kw = nzb_wall+1, nzt_wall -1
5487                   wintend(kw) = ( 1.0_wp / surf_usm_v(l)%rho_c_window(kw,m) )                     &
5488                                 * ( surf_usm_v(l)%lambda_h_window(kw,m)                           &
5489                                     * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) )         &
5490                                     * surf_usm_v(l)%ddz_window(kw+1,m)                            &
5491                                     - surf_usm_v(l)%lambda_h_window(kw-1,m)                       &
5492                                     * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) )         &
5493                                     * surf_usm_v(l)%ddz_window(kw,m)                              &
5494                                     + surf_usm_v(l)%rad_sw_in(m)                                  &
5495                                     * ( exp( -win_absorp * surf_usm_v(l)%zw_window(kw-1,m) )      &
5496                                         - exp(-win_absorp * surf_usm_v(l)%zw_window(kw,m) )       &
5497                                       )                                                           &
5498                                 ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5499                 ENDDO
5500                 wintend(nzt_wall) = ( 1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m) )           &
5501                                     * ( -surf_usm_v(l)%lambda_h_window(nzt_wall-1,m)              &
5502                                         * ( t_window_v(l)%t(nzt_wall,m)                           &
5503                                             - t_window_v(l)%t(nzt_wall-1,m) )                     &
5504                                         * surf_usm_v(l)%ddz_window(nzt_wall,m)                    &
5505                                         + surf_usm_v(l)%iwghf_eb_window(m)                        &
5506                                         + surf_usm_v(l)%rad_sw_in(m)                              &
5507                                         * ( exp( -win_absorp                                      &
5508                                             * surf_usm_v(l)%zw_window(nzt_wall-1,m) )             &
5509                                             - exp(-win_absorp                                     &
5510                                             * surf_usm_v(l)%zw_window(nzt_wall,m) )               &
5511                                           )                                                       &
5512                                        ) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
5513             ELSE
5514                DO  kw = nzb_wall+1, nzt_wall
5515                   wintend(kw) = ( 1.0_wp / surf_usm_v(l)%rho_c_window(kw,m) )                     &
5516                                 * ( surf_usm_v(l)%lambda_h_window(kw,m)                           &
5517                                     * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) )         &
5518                                     * surf_usm_v(l)%ddz_window(kw+1,m)                            &
5519                                     - surf_usm_v(l)%lambda_h_window(kw-1,m)                       &
5520                                     * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) )         &
5521                                     * surf_usm_v(l)%ddz_window(kw,m)                              &
5522                                     + surf_usm_v(l)%rad_sw_in(m)                                  &
5523                                     * ( exp( -win_absorp * surf_usm_v(l)%zw_window(kw-1,m) )      &
5524                                         - exp(-win_absorp                                         &
5525                                         * surf_usm_v(l)%zw_window(kw,m) )                         &
5526                                       )                                                           &
5527                                   ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5528                ENDDO
5529             ENDIF
5530
5531             t_window_v_p(l)%t(nzb_wall:nzt_wall,m) =  t_window_v(l)%t(nzb_wall:nzt_wall,m)        &
5532                                                       + dt_3d * ( tsc(2)                          &
5533                                                       * wintend(nzb_wall:nzt_wall)                &
5534                                                       + tsc(3)                                    &
5535                                                 * surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )
5536          ENDIF
5537
5538!
5539!--       Calculate t_wall tendencies for the next Runge-Kutta step
5540          IF ( timestep_scheme(1:5) == 'runge' )  THEN
5541              IF ( intermediate_timestep_count == 1 )  THEN
5542                 DO  kw = nzb_wall, nzt_wall
5543                    surf_usm_v(l)%tt_wall_m(kw,m) = wtend(kw)
5544                 ENDDO
5545              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
5546                  DO  kw = nzb_wall, nzt_wall
5547                     surf_usm_v(l)%tt_wall_m(kw,m) = - 9.5625_wp * wtend(kw) +                     &
5548                                                     5.3125_wp * surf_usm_v(l)%tt_wall_m(kw,m)
5549                  ENDDO
5550              ENDIF
5551          ENDIF
5552
5553
5554          IF ( .NOT. during_spinup )  THEN
5555!
5556!--          Calculate t_window tendencies for the next Runge-Kutta step
5557             IF ( timestep_scheme(1:5) == 'runge' )  THEN
5558                 IF ( intermediate_timestep_count == 1 )  THEN
5559                    DO  kw = nzb_wall, nzt_wall
5560                       surf_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
5561                    ENDDO
5562                 ELSEIF ( intermediate_timestep_count <  intermediate_timestep_count_max )  THEN
5563                     DO  kw = nzb_wall, nzt_wall
5564                        surf_usm_v(l)%tt_window_m(kw,m) =  - 9.5625_wp * wintend(kw) + 5.3125_wp * &
5565                                                           surf_usm_v(l)%tt_window_m(kw,m)
5566                     ENDDO
5567                 ENDIF
5568             ENDIF
5569          ENDIF
5570
5571       ENDDO
5572    ENDDO
5573    !$OMP END PARALLEL
5574
5575    IF ( debug_output_timestep )  THEN
5576       WRITE( debug_string, * ) 'usm_material_heat_model | during_spinup: ', during_spinup
5577       CALL debug_message( debug_string, 'end' )
5578    ENDIF
5579
5580 END SUBROUTINE usm_material_heat_model
5581
5582!--------------------------------------------------------------------------------------------------!
5583! Description:
5584! ------------
5585!
5586!> Green and substrate model as part of the urban surface model. The model predicts ground
5587!> temperatures.
5588!>
5589!> Important: gree-heat model crashes due to unknown reason. Green fraction is thus set to zero
5590!> (in favor of wall fraction).
5591!--------------------------------------------------------------------------------------------------!
5592 SUBROUTINE usm_green_heat_model
5593
5594
5595    IMPLICIT NONE
5596
5597    INTEGER(iwp)  ::  i, j, k, l, kw, m  !< running indices
5598
5599    LOGICAL  ::  conserve_water_content = .TRUE.  !<
5600
5601    REAL(wp)  ::  drho_l_lv               !< frequently used parameter
5602    REAL(wp)  ::  h_vg                    !< Van Genuchten coef. h
5603    REAL(wp)  ::  ke, lambda_h_green_sat  !< heat conductivity for saturated soil
5604
5605    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  gtend,tend       !< tendency
5606    REAL(wp), DIMENSION(nzb_wall:nzt_wall)  ::  root_extr_green  !<
5607
5608    REAL(wp), DIMENSION(nzb_wall:nzt_wall+1)  ::  gamma_green_temp   !< temp. gamma
5609    REAL(wp), DIMENSION(nzb_wall:nzt_wall+1)  ::  lambda_green_temp  !< temp. lambda
5610
5611
5612
5613
5614
5615    IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'start' )
5616
5617    drho_l_lv = 1.0_wp / (rho_l * l_v)
5618
5619!
5620!-- For horizontal surfaces.
5621!-- Set tendency array for soil moisture to zero
5622    IF ( surf_usm_h%ns > 0 )  THEN
5623       IF ( intermediate_timestep_count == 1 )  surf_usm_h%tswc_h_m = 0.0_wp
5624    ENDIF
5625
5626    !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend,       &
5627    !$OMP&                  tend, h_vg, gamma_green_temp, m_total, root_extr_green)
5628    !$OMP DO SCHEDULE (STATIC)
5629    DO  m = 1, surf_usm_h%ns
5630       IF (surf_usm_h%frac(m,ind_pav_green) > 0.0_wp)  THEN
5631!
5632!--       Obtain indices
5633          i = surf_usm_h%i(m)
5634          j = surf_usm_h%j(m)
5635          k = surf_usm_h%k(m)
5636
5637          DO  kw = nzb_wall, nzt_wall
5638!
5639!--          Calculate volumetric heat capacity of the soil, taking into account water content
5640             surf_usm_h%rho_c_total_green(kw,m) = (surf_usm_h%rho_c_green(kw,m)                    &
5641                                                  * (1.0_wp - swc_sat_h(kw,m))                     &
5642                                                  + rho_c_water * swc_h(kw,m))
5643
5644!
5645!--          Calculate soil heat conductivity at the center of the soil layers
5646             lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(kw,m) )                &
5647                                  * lambda_h_water ** swc_h(kw,m)
5648
5649             ke = 1.0_wp + LOG10( MAX( 0.1_wp,swc_h(kw,m) / swc_sat_h(kw,m) ) )
5650
5651             lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry)                &
5652                                     + lambda_h_green_dry
5653
5654          ENDDO
5655          lambda_green_temp(nzt_wall+1) = lambda_green_temp(nzt_wall)
5656
5657
5658!
5659!--       Calculate soil heat conductivity (lambda_h) at the _stag level using linear interpolation.
5660!--       For pavement surface, the true pavement depth is considered
5661          DO  kw = nzb_wall, nzt_wall
5662             surf_usm_h%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) ) &
5663                                               * 0.5_wp
5664          ENDDO
5665
5666          t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
5667!
5668!--       Prognostic equation for ground/roof temperature t_green_h
5669          gtend(:) = 0.0_wp
5670          gtend(nzb_wall) = ( 1.0_wp / surf_usm_h%rho_c_total_green(nzb_wall,m) )                  &
5671                            * ( surf_usm_h%lambda_h_green(nzb_wall,m)                              &
5672                                * ( t_green_h(nzb_wall+1,m)                                        &
5673                                - t_green_h(nzb_wall,m) )                                          &
5674                                * surf_usm_h%ddz_green(nzb_wall+1,m)                               &
5675                                + surf_usm_h%wghf_eb_green(m)                                      &
5676                              ) * surf_usm_h%ddz_green_stag(nzb_wall,m)
5677
5678           DO  kw = nzb_wall+1, nzt_wall
5679              gtend(kw) = ( 1.0_wp / surf_usm_h%rho_c_total_green(kw,m) )                          &
5680                          * ( surf_usm_h%lambda_h_green(kw,m)                                      &
5681                              * ( t_green_h(kw+1,m) - t_green_h(kw,m) )                            &
5682                              * surf_usm_h%ddz_green(kw+1,m)                                       &
5683                              - surf_usm_h%lambda_h_green(kw-1,m)                                  &
5684                              * ( t_green_h(kw,m) - t_green_h(kw-1,m) )                            &
5685                              * surf_usm_h%ddz_green(kw,m)                                         &
5686                            ) * surf_usm_h%ddz_green_stag(kw,m)
5687           ENDDO
5688
5689           t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m) + dt_3d               &
5690                                              * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3)       &
5691                                                  * surf_usm_h%tt_green_m(nzb_wall:nzt_wall,m) )
5692
5693
5694!
5695!--       Calculate t_green tendencies for the next Runge-Kutta step
5696          IF ( timestep_scheme(1:5) == 'runge' )  THEN
5697              IF ( intermediate_timestep_count == 1 )  THEN
5698                 DO  kw = nzb_wall, nzt_wall
5699                    surf_usm_h%tt_green_m(kw,m) = gtend(kw)
5700                 ENDDO
5701              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
5702                  DO  kw = nzb_wall, nzt_wall
5703                     surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp              &
5704                                                   * surf_usm_h%tt_green_m(kw,m)
5705                  ENDDO
5706              ENDIF
5707          ENDIF
5708
5709          DO  kw = nzb_wall, nzt_wall
5710
5711!
5712!--          Calculate soil diffusivity at the center of the soil layers
5713             lambda_green_temp(kw) = ( - b_ch * surf_usm_h%gamma_w_green_sat(kw,m) * psi_sat       &
5714                                       / swc_sat_h(kw,m) )                                         &
5715                                     * ( MAX( swc_h(kw,m), wilt_h(kw,m) ) / swc_sat_h(kw,m) )**    &
5716                                       ( b_ch + 2.0_wp )
5717
5718!
5719!--          Parametrization of Van Genuchten
5720             IF ( soil_type /= 7 )  THEN
5721!
5722!--             Calculate the hydraulic conductivity after Van Genuchten (1980)
5723                h_vg = ( ( (swc_res_h(kw,m) - swc_sat_h(kw,m)) / ( swc_res_h(kw,m) -               &
5724                           MAX( swc_h(kw,m), wilt_h(kw,m) ) ) )**                                  &
5725                           ( surf_usm_h%n_vg_green(m) / (surf_usm_h%n_vg_green(m) - 1.0_wp ) )     &
5726                           - 1.0_wp                                                                &
5727                       )** ( 1.0_wp / surf_usm_h%n_vg_green(m) ) / surf_usm_h%alpha_vg_green(m)
5728
5729
5730                gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m)                          &
5731                                       * ( ( ( 1.0_wp + ( surf_usm_h%alpha_vg_green(m) * h_vg )**  &
5732                                             surf_usm_h%n_vg_green(m) )**                          &
5733                                             ( 1.0_wp - 1.0_wp / surf_usm_h%n_vg_green(m) )        &
5734                                             - ( surf_usm_h%alpha_vg_green(m) * h_vg )**           &
5735                                             ( surf_usm_h%n_vg_green(m) - 1.0_wp) )**2             &
5736                                         ) / ( ( 1.0_wp + ( surf_usm_h%alpha_vg_green(m) * h_vg )**&
5737                                               surf_usm_h%n_vg_green(m) )**                        &
5738                                               ( ( 1.0_wp  - 1.0_wp / surf_usm_h%n_vg_green(m) )   &
5739                                                 *( surf_usm_h%l_vg_green(m) + 2.0_wp) )           &
5740                                             )
5741
5742!
5743!--          Parametrization of Clapp & Hornberger
5744             ELSE
5745                gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m) * ( swc_h(kw,m)          &
5746                                       / swc_sat_h(kw,m) )**( 2.0_wp * b_ch + 3.0_wp )
5747             ENDIF
5748
5749          ENDDO
5750
5751!
5752!--       Prognostic equation for soil moisture content. Only performed, when humidity is enabled in
5753!--       the atmosphere
5754          IF ( humidity )  THEN
5755!
5756!--          Calculate soil diffusivity (lambda_w) at the _stag level using linear interpolation.
5757!--          To do: replace this with ECMWF-IFS Eq. 8.81
5758             DO  kw = nzb_wall, nzt_wall-1
5759
5760                surf_usm_h%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1)                        &
5761                                                    + lambda_green_temp(kw) )                      &
5762                                                  * 0.5_wp
5763                surf_usm_h%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1)                         &
5764                                                    + gamma_green_temp(kw) )                       &
5765                                                  * 0.5_wp
5766
5767             ENDDO
5768
5769!
5770!--          In case of a closed bottom (= water content is conserved), set hydraulic conductivity
5771!--          to zero so that no water will be lost in the bottom layer.
5772             IF ( conserve_water_content )  THEN
5773                surf_usm_h%gamma_w_green(kw,m) = 0.0_wp
5774             ELSE
5775                surf_usm_h%gamma_w_green(kw,m) = gamma_green_temp(nzt_wall)
5776             ENDIF
5777
5778!--          The root extraction (= root_extr * qsws_veg / (rho_l * l_v)) ensures the mass
5779!--          conservation for water. The transpiration of plants equals the cumulative withdrawals
5780!--          by the roots in the soil. The scheme takes into account the availability of water in
5781!--          the soil layers as well as the root fraction in the respective layer. Layer with
5782!--          moisture below wilting point will not contribute, which reflects the preference of
5783!--          plants to take water from moister layers.
5784
5785!
5786!--          Calculate the root extraction (ECMWF 7.69, the sum of root_extr = 1). The energy
5787!--          balance solver guarantees a positive transpiration, so that there is no need for an
5788!--          additional check.
5789             m_total = 0.0_wp
5790             DO  kw = nzb_wall, nzt_wall
5791                 IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5792                    m_total = m_total + rootfr_h(kw,m) * swc_h(kw,m)
5793                 ENDIF
5794             ENDDO
5795
5796             IF ( m_total > 0.0_wp )  THEN
5797                DO  kw = nzb_wall, nzt_wall
5798                   IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5799                      root_extr_green(kw) = rootfr_h(kw,m) * swc_h(kw,m) / m_total
5800                   ELSE
5801                      root_extr_green(kw) = 0.0_wp
5802                   ENDIF
5803                ENDDO
5804             ENDIF
5805
5806!
5807!--          Prognostic equation for soil water content m_soil.
5808             tend(:) = 0.0_wp
5809
5810             tend(nzb_wall) = ( surf_usm_h%lambda_w_green(nzb_wall,m)                              &
5811                              * ( swc_h(nzb_wall+1,m) - swc_h(nzb_wall,m) )                        &
5812                              * surf_usm_h%ddz_green(nzb_wall+1,m)                                 &
5813                              - surf_usm_h%gamma_w_green(nzb_wall,m)                               &
5814                              - ( root_extr_green(nzb_wall) * surf_usm_h%qsws_veg(m)               &
5815!                                 + surf_usm_h%qsws_soil_green(m)                                  &
5816                                ) * drho_l_lv )                                                    &
5817                              * surf_usm_h%ddz_green_stag(nzb_wall,m)
5818
5819             DO  kw = nzb_wall+1, nzt_wall-1
5820                tend(kw) = ( surf_usm_h%lambda_w_green(kw,m)                                       &
5821                             * ( swc_h(kw+1,m) - swc_h(kw,m) )                                     &
5822                             * surf_usm_h%ddz_green(kw+1,m)                                        &
5823                             - surf_usm_h%gamma_w_green(kw,m)                                      &
5824                             - surf_usm_h%lambda_w_green(kw-1,m)                                   &
5825                             * ( swc_h(kw,m) - swc_h(kw-1,m) )                                     &
5826                             * surf_usm_h%ddz_green(kw,m)                                          &
5827                             + surf_usm_h%gamma_w_green(kw-1,m)                                    &
5828                             - (root_extr_green(kw)                                                &
5829                             * surf_usm_h%qsws_veg(m)                                              &
5830                             * drho_l_lv)                                                          &
5831                          ) * surf_usm_h%ddz_green_stag(kw,m)
5832
5833             ENDDO
5834             tend(nzt_wall) = ( - surf_usm_h%gamma_w_green(nzt_wall,m)                             &
5835                                - surf_usm_h%lambda_w_green(nzt_wall-1,m)                          &
5836                                * (swc_h(nzt_wall,m)                                               &
5837                                - swc_h(nzt_wall-1,m))                                             &
5838                                * surf_usm_h%ddz_green(nzt_wall,m)                                 &
5839                                + surf_usm_h%gamma_w_green(nzt_wall-1,m)                           &
5840                                - ( root_extr_green(nzt_wall)                                      &
5841                                * surf_usm_h%qsws_veg(m)                                           &
5842                                * drho_l_lv  )                                                     &
5843                              ) * surf_usm_h%ddz_green_stag(nzt_wall,m)
5844
5845             swc_h_p(nzb_wall:nzt_wall,m) = swc_h(nzb_wall:nzt_wall,m) + dt_3d                     &
5846                                            * ( tsc(2) * tend(:) + tsc(3)                          &
5847                                                * surf_usm_h%tswc_h_m(:,m)                         &
5848                                               )
5849
5850!
5851!--          Account for dry soils (find a better solution here!)
5852             DO  kw = nzb_wall, nzt_wall
5853                IF ( swc_h_p(kw,m) < 0.0_wp )  swc_h_p(kw,m) = 0.0_wp
5854             ENDDO
5855
5856!
5857!--          Calculate m_soil tendencies for the next Runge-Kutta step
5858             IF ( timestep_scheme(1:5) == 'runge' )  THEN
5859                IF ( intermediate_timestep_count == 1 )  THEN
5860                   DO  kw = nzb_wall, nzt_wall
5861                      surf_usm_h%tswc_h_m(kw,m) = tend(kw)
5862                   ENDDO
5863                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
5864                   DO  kw = nzb_wall, nzt_wall
5865                      surf_usm_h%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp                &
5866                                                  * surf_usm_h%tswc_h_m(kw,m)
5867                   ENDDO
5868                ENDIF
5869             ENDIF
5870          ENDIF
5871
5872       ENDIF
5873
5874    ENDDO
5875    !$OMP END PARALLEL
5876
5877!
5878!-- For vertical surfaces
5879    DO  l = 0, 3
5880       DO  m = 1, surf_usm_v(l)%ns
5881
5882          IF (surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp)  THEN
5883!
5884!-- No substrate layer for green walls / only groundbase green walls (ivy i.e.) -> Green layers get
5885!-- same temperature as first wall layer, therefore no temperature calculations for vertical green
5886!-- substrate layers now
5887
5888!
5889! !
5890! !--          Obtain indices
5891!              i = surf_usm_v(l)%i(m)
5892!              j = surf_usm_v(l)%j(m)
5893!              k = surf_usm_v(l)%k(m)
5894!
5895!              t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
5896! !
5897! !--          Prognostic equation for green temperature t_green_v
5898!              gtend(:) = 0.0_wp
5899!              gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
5900!                                      ( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
5901!                                        ( t_green_v(l)%t(nzb_wall+1,m)             &
5902!                                        - t_green_v(l)%t(nzb_wall,m) ) *           &
5903!                                        surf_usm_v(l)%ddz_green(nzb_wall+1,m)      &
5904!                                      + surf_usm_v(l)%wghf_eb(m) ) *               &
5905!                                        surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
5906!
5907!              DO  kw = nzb_wall+1, nzt_wall
5908!                 gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m))          &
5909!                           * (   surf_usm_v(l)%lambda_h_green(kw,m)              &
5910!                             * ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
5911!                             * surf_usm_v(l)%ddz_green(kw+1,m)                   &
5912!                           - surf_usm_v(l)%lambda_h(kw-1,m)                      &
5913!                             * ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
5914!                             * surf_usm_v(l)%ddz_green(kw,m) )                   &
5915!                           * surf_usm_v(l)%ddz_green_stag(kw,m)
5916!              ENDDO
5917!
5918!              t_green_v_p(l)%t(nzb_wall:nzt_wall,m) =                              &
5919!                                   t_green_v(l)%t(nzb_wall:nzt_wall,m)             &
5920!                                 + dt_3d * ( tsc(2)                                &
5921!                                 * gtend(nzb_wall:nzt_wall) + tsc(3)               &
5922!                                 * surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall,m) )
5923!
5924! !
5925! !--          Calculate t_green tendencies for the next Runge-Kutta step
5926!              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5927!                  IF ( intermediate_timestep_count == 1 )  THEN
5928!                     DO  kw = nzb_wall, nzt_wall
5929!                        surf_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
5930!                     ENDDO
5931!                  ELSEIF ( intermediate_timestep_count <                           &
5932!                           intermediate_timestep_count_max )  THEN
5933!                      DO  kw = nzb_wall, nzt_wall
5934!                         surf_usm_v(l)%tt_green_m(kw,m) =                          &
5935!                                     - 9.5625_wp * gtend(kw) +                     &
5936!                                       5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
5937!                      ENDDO
5938!                  ENDIF
5939!              ENDIF
5940
5941             DO  kw = nzb_wall, nzt_wall+1
5942                 t_green_v(l)%t(kw,m) = t_wall_v(l)%t(nzb_wall,m)
5943             ENDDO
5944
5945          ENDIF
5946
5947       ENDDO
5948    ENDDO
5949
5950    IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'end' )
5951
5952 END SUBROUTINE usm_green_heat_model
5953
5954!--------------------------------------------------------------------------------------------------!
5955! Description:
5956! ------------
5957!> Parin for &usm_par for urban surface model
5958!--------------------------------------------------------------------------------------------------!
5959 SUBROUTINE usm_parin
5960
5961    IMPLICIT NONE
5962
5963    CHARACTER(LEN=80)  ::  line  !< string containing current line of file PARIN
5964
5965    NAMELIST /urban_surface_par/                                                                   &
5966                        building_type,                                                             &
5967                        land_category,                                                             &
5968                        naheatlayers,                                                              &
5969                        pedestrian_category,                                                       &
5970                        read_wall_temp_3d,                                                         &
5971                        roof_category,                                                             &
5972                        roof_inner_temperature,                                                    &
5973                        roughness_concrete,                                                        &
5974                        soil_inner_temperature,                                                    &
5975                        urban_surface,                                                             &
5976                        usm_anthropogenic_heat,                                                    &
5977                        usm_material_model,                                                        &
5978                        usm_wall_mod,                                                              &
5979                        wall_category,                                                             &
5980                        wall_inner_temperature,                                                    &
5981                        window_inner_temperature
5982
5983
5984    NAMELIST /urban_surface_parameters/                                                            &
5985                        building_type,                                                             &
5986                        land_category,                                                             &
5987                        naheatlayers,                                                              &
5988                        pedestrian_category,                                                       &
5989                        read_wall_temp_3d,                                                         &
5990                        roof_category,                                                             &
5991                        roof_inner_temperature,                                                    &
5992                        roughness_concrete,                                                        &
5993                        soil_inner_temperature,                                                    &
5994                        urban_surface,                                                             &
5995                        usm_anthropogenic_heat,                                                    &
5996                        usm_material_model,                                                        &
5997                        usm_wall_mod,                                                              &
5998                        wall_category,                                                             &
5999                        wall_inner_temperature,                                                    &
6000                        window_inner_temperature
6001
6002
6003
6004!
6005!-- Try to find urban surface model package
6006    REWIND ( 11 )
6007    line = ' '
6008    DO WHILE ( INDEX( line, '&urban_surface_parameters' ) == 0 )
6009       READ ( 11, '(A)', END = 12 )  line
6010    ENDDO
6011    BACKSPACE ( 11 )
6012
6013!
6014!-- Read user-defined namelist
6015    READ ( 11, urban_surface_parameters, ERR = 10 )
6016
6017!
6018!-- Set flag that indicates that the urban surface model is switched on
6019    urban_surface = .TRUE.
6020
6021    GOTO 14
6022
6023 10 BACKSPACE( 11 )
6024    READ( 11 , '(A)') line
6025    CALL parin_fail_message( 'urban_surface_parameters', line )
6026!
6027!-- Try to find old namelist
6028 12 REWIND ( 11 )
6029    line = ' '
6030    DO WHILE ( INDEX( line, '&urban_surface_par' ) == 0 )
6031       READ ( 11, '(A)', END = 14 )  line
6032    ENDDO
6033    BACKSPACE ( 11 )
6034
6035!
6036!-- Read user-defined namelist
6037    READ ( 11, urban_surface_par, ERR = 13, END = 14 )
6038
6039    message_string = 'namelist urban_surface_par is deprecated and will be removed in near ' //    &
6040                     'future. Please use namelist urban_surface_parameters instead'
6041    CALL message( 'usm_parin', 'PA0487', 0, 1, 0, 6, 0 )
6042
6043!
6044!-- Set flag that indicates that the urban surface model is switched on
6045    urban_surface = .TRUE.
6046
6047    GOTO 14
6048
6049 13 BACKSPACE( 11 )
6050    READ( 11 , '(A)') line
6051    CALL parin_fail_message( 'urban_surface_par', line )
6052
6053
6054 14 CONTINUE
6055
6056
6057 END SUBROUTINE usm_parin
6058
6059
6060!--------------------------------------------------------------------------------------------------!
6061! Description:
6062! ------------
6063!
6064!> This subroutine is part of the urban surface model.
6065!> It reads daily heat produced by anthropogenic source and the diurnal cycle of the heat.
6066!--------------------------------------------------------------------------------------------------!
6067 SUBROUTINE usm_read_anthropogenic_heat
6068
6069    INTEGER(iwp)  ::  i, ii, j, k  !< running indices
6070
6071    REAL(wp)      ::  heat      !< anthropogenic heat
6072
6073!
6074!-- Allocation of array of sources of anthropogenic heat and their diural profile
6075    ALLOCATE( aheat(naheatlayers,nys:nyn,nxl:nxr) )
6076    ALLOCATE( aheatprof(naheatlayers,0:24) )
6077
6078!
6079!-- Read daily amount of heat and its daily cycle
6080    aheat = 0.0_wp
6081    DO  ii = 0, io_blocks-1
6082        IF ( ii == io_group )  THEN
6083
6084!--         Open anthropogenic heat file
6085            OPEN( 151, file = 'ANTHROPOGENIC_HEAT' // TRIM( coupling_char ), action = 'read',      &
6086                  status = 'old', form = 'formatted', err = 11 )
6087            i = 0
6088            j = 0
6089            DO
6090                READ( 151, *, ERR=12, END=13 )  i, j, k, heat
6091                IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )  THEN
6092                    IF ( k <= naheatlayers  .AND.  k > topo_top_ind(j,i,0) )  THEN
6093!--                     Write heat into the array
6094                        aheat(k,j,i) = heat
6095                    ENDIF
6096                ENDIF
6097                CYCLE
6098 12             WRITE( message_string, '(a,2i4)' ) 'error in file ANTHROPOGENIC_HEAT'              &
6099                                                   // TRIM( coupling_char ) // ' after line ', i, j
6100                CALL message( 'usm_read_anthropogenic_heat', 'PA0515', 0, 1, 0, 6, 0 )
6101            ENDDO
6102 13         CLOSE( 151 )
6103            CYCLE
6104 11         message_string = 'file ANTHROPOGENIC_HEAT' // TRIM( coupling_char ) // ' does not exist'
6105            CALL message( 'usm_read_anthropogenic_heat', 'PA0516', 1, 2, 0, 6, 0 )
6106        ENDIF
6107
6108#if defined( __parallel )
6109        CALL MPI_BARRIER( comm2d, ierr )
6110#endif
6111    ENDDO
6112
6113!
6114!-- Read diurnal profiles of heat sources
6115    aheatprof = 0.0_wp
6116    DO  ii = 0, io_blocks-1
6117       IF ( ii == io_group )  THEN
6118!
6119!--         Open anthropogenic heat profile file
6120            OPEN( 151, file = 'ANTHROPOGENIC_HEAT_PROFILE' // TRIM( coupling_char ),               &
6121                  action = 'read', status = 'old', form = 'formatted', err = 21 )
6122            i = 0
6123            DO
6124               READ( 151, *, err = 22, end = 23 )  i, k, heat
6125!
6126!--            Write heat into the array
6127               IF ( i >= 0  .AND.  i <= 24  .AND.  k <= naheatlayers )  THEN
6128                   aheatprof(k,i) = heat
6129               ENDIF
6130               CYCLE
6131 22            WRITE( message_string, '(a,i4)' ) 'error in file ANTHROPOGENIC_HEAT_PROFILE' //     &
6132                                                  TRIM( coupling_char ) // ' after line ', i
6133               CALL message( 'usm_read_anthropogenic_heat', 'PA0517', 0, 1, 0, 6, 0 )
6134            ENDDO
6135            aheatprof(:,24) = aheatprof(:,0)
6136 23         CLOSE( 151 )
6137            CYCLE
6138 21         message_string = 'file ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char)//' does not exist'
6139            CALL message( 'usm_read_anthropogenic_heat', 'PA0518', 1, 2, 0, 6, 0 )
6140        ENDIF
6141
6142#if defined( __parallel )
6143        CALL MPI_BARRIER( comm2d, ierr )
6144#endif
6145    ENDDO
6146
6147 END SUBROUTINE usm_read_anthropogenic_heat
6148
6149
6150!--------------------------------------------------------------------------------------------------!
6151! Description:
6152! ------------
6153!> Read module-specific local restart data arrays (Fortran binary format).
6154!> Soubroutine reads t_surf and t_wall.
6155!--------------------------------------------------------------------------------------------------!
6156 SUBROUTINE usm_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, nyn_on_file,   &
6157                               nysf, nysc, nys_on_file, found )
6158
6159
6160    USE control_parameters,                                                                        &
6161        ONLY: length,                                                                              &
6162              restart_string
6163
6164    IMPLICIT NONE
6165
6166    INTEGER(iwp)  ::  k                 !< running index over previous input files covering current local domain
6167    INTEGER(iwp)  ::  l                 !< index variable for surface type
6168    INTEGER(iwp)  ::  ns_h_on_file_usm  !< number of horizontal surface elements (urban type) on file
6169    INTEGER(iwp)  ::  nxlc              !< index of left boundary on current subdomain
6170    INTEGER(iwp)  ::  nxlf              !< index of left boundary on former subdomain
6171    INTEGER(iwp)  ::  nxl_on_file       !< index of left boundary on former local domain
6172    INTEGER(iwp)  ::  nxrf              !< index of right boundary on former subdomain
6173    INTEGER(iwp)  ::  nxr_on_file       !< index of right boundary on former local domain
6174    INTEGER(iwp)  ::  nynf              !< index of north boundary on former subdomain
6175    INTEGER(iwp)  ::  nyn_on_file       !< index of north boundary on former local domain
6176    INTEGER(iwp)  ::  nysc              !< index of south boundary on current subdomain
6177    INTEGER(iwp)  ::  nysf              !< index of south boundary on former subdomain
6178    INTEGER(iwp)  ::  nys_on_file       !< index of south boundary on former local domain
6179    INTEGER(iwp)  ::  ns_v_on_file_usm(0:3)  !< number of vertical surface elements (urban type) on file
6180!
6181!-- Note, the save attribute in the following array declaration is necessary, in order to keep the
6182!-- number of urban surface elements on file during rrd_local calls.
6183    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  end_index_on_file    !<
6184    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  start_index_on_file  !<
6185
6186    LOGICAL, INTENT(OUT)  ::  found  !<
6187
6188! MS: Why are there individual temporary arrays that all have the same size?
6189    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  tmp_surf_green_h   !<
6190    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  tmp_surf_mliq_h    !<
6191    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  tmp_surf_wall_h    !<
6192    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  tmp_surf_waste_h   !<
6193    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  tmp_surf_window_h  !<
6194
6195    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_green_h   !<
6196    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_wall_h    !<
6197    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_window_h  !<
6198
6199    TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_green_v   !<
6200    TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v    !<
6201    TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_waste_v   !<
6202    TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_window_v  !<
6203
6204    TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_green_v   !<
6205    TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_wall_v    !<
6206    TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_window_v  !<
6207
6208
6209    found = .TRUE.
6210
6211
6212    SELECT CASE ( restart_string(1:length) )
6213
6214       CASE ( 'ns_h_on_file_usm')
6215          IF ( k == 1 )  THEN
6216             READ ( 13 ) ns_h_on_file_usm
6217
6218             IF ( ALLOCATED( tmp_surf_wall_h ) )    DEALLOCATE( tmp_surf_wall_h )
6219             IF ( ALLOCATED( tmp_wall_h ) )         DEALLOCATE( tmp_wall_h )
6220             IF ( ALLOCATED( tmp_surf_window_h ) )  DEALLOCATE( tmp_surf_window_h )
6221             IF ( ALLOCATED( tmp_window_h) )        DEALLOCATE( tmp_window_h )
6222             IF ( ALLOCATED( tmp_surf_green_h) )    DEALLOCATE( tmp_surf_green_h )
6223             IF ( ALLOCATED( tmp_green_h) )         DEALLOCATE( tmp_green_h )
6224             IF ( ALLOCATED( tmp_surf_mliq_h) )     DEALLOCATE( tmp_surf_mliq_h )
6225             IF ( ALLOCATED( tmp_surf_waste_h) )    DEALLOCATE( tmp_surf_waste_h )
6226
6227!
6228!--          Allocate temporary arrays for reading data on file. Note, the size of allocated surface
6229!--          elements do not necessarily need  to match the size of present surface elements on
6230!--          current processor, as the number of processors between restarts can change.
6231             ALLOCATE( tmp_surf_wall_h(1:ns_h_on_file_usm) )
6232             ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm) )
6233             ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
6234             ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm) )
6235             ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
6236             ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1, 1:ns_h_on_file_usm) )
6237             ALLOCATE( tmp_surf_mliq_h(1:ns_h_on_file_usm) )
6238             ALLOCATE( tmp_surf_waste_h(1:ns_h_on_file_usm) )
6239
6240          ENDIF
6241
6242       CASE ( 'ns_v_on_file_usm')
6243          IF ( k == 1 )  THEN
6244             READ ( 13 ) ns_v_on_file_usm
6245
6246             DO  l = 0, 3
6247                IF ( ALLOCATED( tmp_surf_wall_v(l)%t ) )    DEALLOCATE( tmp_surf_wall_v(l)%t )
6248                IF ( ALLOCATED( tmp_wall_v(l)%t ) )         DEALLOCATE( tmp_wall_v(l)%t )
6249                IF ( ALLOCATED( tmp_surf_window_v(l)%t ) )  DEALLOCATE( tmp_surf_window_v(l)%t )
6250                IF ( ALLOCATED( tmp_window_v(l)%t ) )       DEALLOCATE( tmp_window_v(l)%t )
6251                IF ( ALLOCATED( tmp_surf_green_v(l)%t ) )   DEALLOCATE( tmp_surf_green_v(l)%t )
6252                IF ( ALLOCATED( tmp_green_v(l)%t ) )        DEALLOCATE( tmp_green_v(l)%t )
6253                IF ( ALLOCATED( tmp_surf_waste_v(l)%t ) )   DEALLOCATE( tmp_surf_waste_v(l)%t )
6254             ENDDO
6255
6256!
6257!--          Allocate temporary arrays for reading data on file. Note, the size of allocated surface
6258!--          elements do not necessarily need to match the size of present surface elements on
6259!--          current processor, as the number of processors between restarts can change.
6260             DO  l = 0, 3
6261                ALLOCATE( tmp_surf_wall_v(l)%t(1:ns_v_on_file_usm(l)) )
6262                ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
6263                ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
6264                ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
6265                ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
6266                ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1, 1:ns_v_on_file_usm(l) ) )
6267                ALLOCATE( tmp_surf_waste_v(l)%t(1:ns_v_on_file_usm(l)) )
6268             ENDDO
6269
6270          ENDIF
6271
6272       CASE ( 'usm_start_index_h', 'usm_start_index_v'  )
6273          IF ( k == 1 )  THEN
6274
6275             IF ( ALLOCATED( start_index_on_file ) )  DEALLOCATE( start_index_on_file )
6276
6277             ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, nxl_on_file:nxr_on_file) )
6278
6279             READ ( 13 )  start_index_on_file
6280
6281          ENDIF
6282
6283       CASE ( 'usm_end_index_h', 'usm_end_index_v' )
6284          IF ( k == 1 )  THEN
6285
6286             IF ( ALLOCATED( end_index_on_file ) )  DEALLOCATE( end_index_on_file )
6287
6288             ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file, nxl_on_file:nxr_on_file) )
6289
6290             READ ( 13 )  end_index_on_file
6291
6292          ENDIF
6293
6294       CASE ( 't_surf_wall_h' )
6295          IF ( k == 1 )  THEN
6296             IF ( .NOT.  ALLOCATED( t_surf_wall_h_1 ) )   ALLOCATE( t_surf_wall_h_1(1:surf_usm_h%ns) )
6297             READ ( 13 )  tmp_surf_wall_h
6298          ENDIF
6299          CALL surface_restore_elements( t_surf_wall_h_1, tmp_surf_wall_h, surf_usm_h%start_index, &
6300                                         start_index_on_file, end_index_on_file, nxlc, nysc,       &
6301                                         nxlf, nxrf, nysf, nynf, nys_on_file, nyn_on_file,         &
6302                                         nxl_on_file, nxr_on_file )
6303
6304       CASE ( 't_surf_wall_v(0)' )
6305          IF ( k == 1 )  THEN
6306             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(0)%t ) )                                       &
6307                ALLOCATE( t_surf_wall_v_1(0)%t(1:surf_usm_v(0)%ns) )
6308             READ ( 13 )  tmp_surf_wall_v(0)%t
6309          ENDIF
6310          CALL surface_restore_elements( t_surf_wall_v_1(0)%t, tmp_surf_wall_v(0)%t,               &
6311                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6312                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6313                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6314
6315       CASE ( 't_surf_wall_v(1)' )
6316          IF ( k == 1 )  THEN
6317             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(1)%t ) )                                       &
6318                ALLOCATE( t_surf_wall_v_1(1)%t(1:surf_usm_v(1)%ns) )
6319             READ ( 13 )  tmp_surf_wall_v(1)%t
6320          ENDIF
6321          CALL surface_restore_elements( t_surf_wall_v_1(1)%t, tmp_surf_wall_v(1)%t,               &
6322                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6323                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6324                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6325
6326       CASE ( 't_surf_wall_v(2)' )
6327          IF ( k == 1 )  THEN
6328             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(2)%t ) )                                       &
6329                ALLOCATE( t_surf_wall_v_1(2)%t(1:surf_usm_v(2)%ns) )
6330             READ ( 13 )  tmp_surf_wall_v(2)%t
6331          ENDIF
6332          CALL surface_restore_elements( t_surf_wall_v_1(2)%t, tmp_surf_wall_v(2)%t,               &
6333                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6334                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6335                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6336
6337       CASE ( 't_surf_wall_v(3)' )
6338          IF ( k == 1 )  THEN
6339             IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(3)%t ) )                                       &
6340                ALLOCATE( t_surf_wall_v_1(3)%t(1:surf_usm_v(3)%ns) )
6341             READ ( 13 )  tmp_surf_wall_v(3)%t
6342          ENDIF
6343          CALL surface_restore_elements( t_surf_wall_v_1(3)%t, tmp_surf_wall_v(3)%t,               &
6344                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6345                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6346                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6347
6348       CASE ( 't_surf_green_h' )
6349          IF ( k == 1 )  THEN
6350             IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )                                           &
6351                ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
6352             READ ( 13 )  tmp_surf_green_h
6353          ENDIF
6354          CALL surface_restore_elements( t_surf_green_h_1, tmp_surf_green_h,                       &
6355                                         surf_usm_h%start_index, start_index_on_file,              &
6356                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6357                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6358
6359       CASE ( 't_surf_green_v(0)' )
6360          IF ( k == 1 )  THEN
6361             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%t ) )                                      &
6362                ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
6363             READ ( 13 )  tmp_surf_green_v(0)%t
6364          ENDIF
6365          CALL surface_restore_elements( t_surf_green_v_1(0)%t, tmp_surf_green_v(0)%t,             &
6366                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6367                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6368                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6369
6370       CASE ( 't_surf_green_v(1)' )
6371          IF ( k == 1 )  THEN
6372             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%t ) )                                      &
6373                ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
6374             READ ( 13 )  tmp_surf_green_v(1)%t
6375          ENDIF
6376          CALL surface_restore_elements( t_surf_green_v_1(1)%t, tmp_surf_green_v(1)%t,             &
6377                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6378                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6379                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6380
6381       CASE ( 't_surf_green_v(2)' )
6382          IF ( k == 1 )  THEN
6383             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%t ) )                                      &
6384                ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
6385             READ ( 13 )  tmp_surf_green_v(2)%t
6386          ENDIF
6387          CALL surface_restore_elements( t_surf_green_v_1(2)%t, tmp_surf_green_v(2)%t,             &
6388                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6389                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6390                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6391
6392       CASE ( 't_surf_green_v(3)' )
6393          IF ( k == 1 )  THEN
6394             IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%t ) )                                      &
6395                ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
6396             READ ( 13 )  tmp_surf_green_v(3)%t
6397          ENDIF
6398          CALL surface_restore_elements( t_surf_green_v_1(3)%t, tmp_surf_green_v(3)%t,             &
6399                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6400                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6401                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6402
6403       CASE ( 't_surf_window_h' )
6404          IF ( k == 1 )  THEN
6405             IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )                                          &
6406                ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
6407             READ ( 13 )  tmp_surf_window_h
6408          ENDIF
6409          CALL surface_restore_elements( t_surf_window_h_1, tmp_surf_window_h,                     &
6410                                         surf_usm_h%start_index, start_index_on_file,              &
6411                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6412                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6413
6414       CASE ( 't_surf_window_v(0)' )
6415          IF ( k == 1 )  THEN
6416             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%t ) )                                     &
6417                ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
6418             READ ( 13 )  tmp_surf_window_v(0)%t
6419          ENDIF
6420          CALL surface_restore_elements( t_surf_window_v_1(0)%t, tmp_surf_window_v(0)%t,           &
6421                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6422                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6423                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6424
6425       CASE ( 't_surf_window_v(1)' )
6426          IF ( k == 1 )  THEN
6427             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%t ) )                                     &
6428                ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
6429             READ ( 13 )  tmp_surf_window_v(1)%t
6430          ENDIF
6431          CALL surface_restore_elements( t_surf_window_v_1(1)%t, tmp_surf_window_v(1)%t,           &
6432                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6433                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6434                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6435
6436       CASE ( 't_surf_window_v(2)' )
6437          IF ( k == 1 )  THEN
6438             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%t ) )                                     &
6439                ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
6440             READ ( 13 )  tmp_surf_window_v(2)%t
6441          ENDIF
6442          CALL surface_restore_elements( t_surf_window_v_1(2)%t, tmp_surf_window_v(2)%t,           &
6443                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6444                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6445                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6446
6447       CASE ( 't_surf_window_v(3)' )
6448          IF ( k == 1 )  THEN
6449             IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%t ) )                                     &
6450                ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
6451             READ ( 13 )  tmp_surf_window_v(3)%t
6452          ENDIF
6453          CALL surface_restore_elements( t_surf_window_v_1(3)%t, tmp_surf_window_v(3)%t,           &
6454                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6455                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6456                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6457
6458       CASE ( 'm_liq_usm_h' )
6459          IF ( k == 1 )  THEN
6460             IF ( .NOT.  ALLOCATED( m_liq_usm_h%var_usm_1d ) )                                     &
6461                ALLOCATE( m_liq_usm_h%var_usm_1d(1:surf_usm_h%ns) )
6462             READ ( 13 )  tmp_surf_mliq_h
6463          ENDIF
6464          CALL surface_restore_elements( m_liq_usm_h%var_usm_1d, tmp_surf_mliq_h,                  &
6465                                         surf_usm_h%start_index, start_index_on_file,              &
6466                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6467                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6468
6469       CASE ( 'waste_heat_h' )
6470          IF ( k == 1 )  THEN
6471             IF ( .NOT.  ALLOCATED( surf_usm_h%waste_heat ) )                                      &
6472                ALLOCATE( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
6473             READ ( 13 )  tmp_surf_waste_h
6474          ENDIF
6475          CALL surface_restore_elements( surf_usm_h%waste_heat, tmp_surf_waste_h,                  &
6476                                         surf_usm_h%start_index, start_index_on_file,              &
6477                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6478                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6479
6480       CASE ( 'waste_heat_v(0)' )
6481          IF ( k == 1 )  THEN
6482             IF ( .NOT.  ALLOCATED( surf_usm_v(0)%waste_heat ) )                                   &
6483                ALLOCATE( surf_usm_v(0)%waste_heat(1:surf_usm_v(0)%ns) )
6484             READ ( 13 )  tmp_surf_waste_v(0)%t
6485          ENDIF
6486          CALL surface_restore_elements( surf_usm_v(0)%waste_heat, tmp_surf_waste_v(0)%t,          &
6487                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6488                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6489                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6490
6491       CASE ( 'waste_heat_v(1)' )
6492          IF ( k == 1 )  THEN
6493             IF ( .NOT.  ALLOCATED( surf_usm_v(1)%waste_heat ) )                                   &
6494                ALLOCATE( surf_usm_v(1)%waste_heat(1:surf_usm_v(1)%ns) )
6495             READ ( 13 )  tmp_surf_waste_v(1)%t
6496          ENDIF
6497          CALL surface_restore_elements( surf_usm_v(1)%waste_heat, tmp_surf_waste_v(1)%t,          &
6498                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6499                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6500                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6501
6502       CASE ( 'waste_heat_v(2)' )
6503          IF ( k == 1 )  THEN
6504             IF ( .NOT.  ALLOCATED( surf_usm_v(2)%waste_heat ) )                                   &
6505                ALLOCATE( surf_usm_v(2)%waste_heat(1:surf_usm_v(2)%ns) )
6506             READ ( 13 )  tmp_surf_waste_v(2)%t
6507          ENDIF
6508          CALL surface_restore_elements( surf_usm_v(2)%waste_heat, tmp_surf_waste_v(2)%t,          &
6509                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6510                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6511                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6512
6513       CASE ( 'waste_heat_v(3)' )
6514          IF ( k == 1 )  THEN
6515             IF ( .NOT.  ALLOCATED( surf_usm_v(3)%waste_heat ) )                                   &
6516                ALLOCATE( surf_usm_v(3)%waste_heat(1:surf_usm_v(3)%ns) )
6517             READ ( 13 )  tmp_surf_waste_v(3)%t
6518          ENDIF
6519          CALL surface_restore_elements( surf_usm_v(3)%waste_heat, tmp_surf_waste_v(3)%t,          &
6520                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6521                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6522                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6523
6524       CASE ( 't_wall_h' )
6525          IF ( k == 1 )  THEN
6526             IF ( .NOT.  ALLOCATED( t_wall_h_1 ) )                                                 &
6527                ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1, 1:surf_usm_h%ns) )
6528             READ ( 13 )  tmp_wall_h
6529          ENDIF
6530          CALL surface_restore_elements( t_wall_h_1, tmp_wall_h, surf_usm_h%start_index,           &
6531                                         start_index_on_file, end_index_on_file,                   &
6532                                         nxlc, nysc, nxlf, nxrf, nysf, nynf,                       &
6533                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6534
6535
6536
6537
6538       CASE ( 't_wall_v(0)' )
6539          IF ( k == 1 )  THEN
6540             IF ( .NOT.  ALLOCATED( t_wall_v_1(0)%t ) )                                            &
6541                ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
6542             READ ( 13 )  tmp_wall_v(0)%t
6543          ENDIF
6544          CALL surface_restore_elements( t_wall_v_1(0)%t, tmp_wall_v(0)%t,                         &
6545                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6546                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6547                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6548
6549       CASE ( 't_wall_v(1)' )
6550          IF ( k == 1 )  THEN
6551             IF ( .NOT.  ALLOCATED( t_wall_v_1(1)%t ) )                                            &
6552                ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
6553             READ ( 13 )  tmp_wall_v(1)%t
6554          ENDIF
6555          CALL surface_restore_elements( t_wall_v_1(1)%t, tmp_wall_v(1)%t,                         &
6556                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6557                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6558                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6559
6560       CASE ( 't_wall_v(2)' )
6561          IF ( k == 1 )  THEN
6562             IF ( .NOT.  ALLOCATED( t_wall_v_1(2)%t ) )                                            &
6563                ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
6564             READ ( 13 )  tmp_wall_v(2)%t
6565          ENDIF
6566          CALL surface_restore_elements( t_wall_v_1(2)%t, tmp_wall_v(2)%t,                         &
6567                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6568                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6569                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6570
6571       CASE ( 't_wall_v(3)' )
6572          IF ( k == 1 )  THEN
6573             IF ( .NOT.  ALLOCATED( t_wall_v_1(3)%t ) )                                            &
6574                ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(3)%ns) )
6575             READ ( 13 )  tmp_wall_v(3)%t
6576          ENDIF
6577          CALL surface_restore_elements( t_wall_v_1(3)%t, tmp_wall_v(3)%t,                         &
6578                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6579                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6580                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6581
6582       CASE ( 't_green_h' )
6583          IF ( k == 1 )  THEN
6584             IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                                                &
6585                ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1, 1:surf_usm_h%ns) )
6586             READ ( 13 )  tmp_green_h
6587          ENDIF
6588          CALL surface_restore_elements( t_green_h_1, tmp_green_h, surf_usm_h%start_index,         &
6589                                         start_index_on_file, end_index_on_file, nxlc, nysc,       &
6590                                         nxlf, nxrf, nysf, nynf, nys_on_file, nyn_on_file,         &
6591                                         nxl_on_file,nxr_on_file )
6592
6593       CASE ( 't_green_v(0)' )
6594          IF ( k == 1 )  THEN
6595             IF ( .NOT.  ALLOCATED( t_green_v_1(0)%t ) )                                           &
6596                ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
6597             READ ( 13 )  tmp_green_v(0)%t
6598          ENDIF
6599          CALL surface_restore_elements( t_green_v_1(0)%t, tmp_green_v(0)%t,                       &
6600                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6601                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6602                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6603
6604       CASE ( 't_green_v(1)' )
6605          IF ( k == 1 )  THEN
6606             IF ( .NOT.  ALLOCATED( t_green_v_1(1)%t ) )                                           &
6607                ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
6608             READ ( 13 )  tmp_green_v(1)%t
6609          ENDIF
6610          CALL surface_restore_elements( t_green_v_1(1)%t, tmp_green_v(1)%t,                       &
6611                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6612                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6613                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6614
6615       CASE ( 't_green_v(2)' )
6616          IF ( k == 1 )  THEN
6617             IF ( .NOT.  ALLOCATED( t_green_v_1(2)%t ) )                                           &
6618                ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
6619             READ ( 13 )  tmp_green_v(2)%t
6620          ENDIF
6621          CALL surface_restore_elements( t_green_v_1(2)%t, tmp_green_v(2)%t,                       &
6622                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6623                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6624                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6625
6626       CASE ( 't_green_v(3)' )
6627          IF ( k == 1 )  THEN
6628             IF ( .NOT.  ALLOCATED( t_green_v_1(3)%t ) )                                           &
6629                ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(3)%ns) )
6630             READ ( 13 )  tmp_green_v(3)%t
6631          ENDIF
6632          CALL surface_restore_elements( t_green_v_1(3)%t, tmp_green_v(3)%t,                       &
6633                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6634                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6635                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6636
6637       CASE ( 't_window_h' )
6638          IF ( k == 1 )  THEN
6639             IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                                               &
6640                ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1, 1:surf_usm_h%ns) )
6641             READ ( 13 )  tmp_window_h
6642          ENDIF
6643          CALL surface_restore_elements( t_window_h_1, tmp_window_h, surf_usm_h%start_index,       &
6644                                         start_index_on_file, end_index_on_file, nxlc, nysc,       &
6645                                         nxlf, nxrf, nysf, nynf, nys_on_file, nyn_on_file,         &
6646                                         nxl_on_file, nxr_on_file )
6647
6648       CASE ( 't_window_v(0)' )
6649          IF ( k == 1 )  THEN
6650             IF ( .NOT.  ALLOCATED( t_window_v_1(0)%t ) )                                          &
6651                ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(0)%ns) )
6652             READ ( 13 )  tmp_window_v(0)%t
6653          ENDIF
6654          CALL surface_restore_elements( t_window_v_1(0)%t, tmp_window_v(0)%t,                     &
6655                                         surf_usm_v(0)%start_index, start_index_on_file,           &
6656                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6657                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6658
6659       CASE ( 't_window_v(1)' )
6660          IF ( k == 1 )  THEN
6661             IF ( .NOT.  ALLOCATED( t_window_v_1(1)%t ) )                                          &
6662                ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(1)%ns) )
6663             READ ( 13 )  tmp_window_v(1)%t
6664          ENDIF
6665          CALL surface_restore_elements( t_window_v_1(1)%t, tmp_window_v(1)%t,                     &
6666                                         surf_usm_v(1)%start_index, start_index_on_file,           &
6667                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6668                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6669
6670       CASE ( 't_window_v(2)' )
6671          IF ( k == 1 )  THEN
6672             IF ( .NOT.  ALLOCATED( t_window_v_1(2)%t ) )                                          &
6673                ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1, 1:surf_usm_v(2)%ns) )
6674             READ ( 13 )  tmp_window_v(2)%t
6675          ENDIF
6676          CALL surface_restore_elements( t_window_v_1(2)%t, tmp_window_v(2)%t,                     &
6677                                         surf_usm_v(2)%start_index, start_index_on_file,           &
6678                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6679                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6680
6681       CASE ( 't_window_v(3)' )
6682          IF ( k == 1 )  THEN
6683             IF ( .NOT.  ALLOCATED( t_window_v_1(3)%t ) )                                          &
6684                ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
6685             READ ( 13 )  tmp_window_v(3)%t
6686          ENDIF
6687          CALL surface_restore_elements( t_window_v_1(3)%t, tmp_window_v(3)%t,                     &
6688                                         surf_usm_v(3)%start_index, start_index_on_file,           &
6689                                         end_index_on_file, nxlc, nysc, nxlf, nxrf, nysf, nynf,    &
6690                                         nys_on_file, nyn_on_file, nxl_on_file,nxr_on_file )
6691
6692       CASE DEFAULT
6693
6694          found = .FALSE.
6695
6696    END SELECT
6697
6698 END SUBROUTINE usm_rrd_local_ftn
6699
6700
6701!--------------------------------------------------------------------------------------------------!
6702! Description:
6703! ------------
6704!> Read module-specific local restart data arrays (MPI-IO).
6705!> Soubroutine reads t_surf and t_wall.
6706!>
6707!> This read routine is a counterpart of usm_wrd_local.
6708!> In usm_wrd_local, all array are unconditionally written, therefore all arrays are read here.
6709!> This is a preliminary version of reading usm data. The final version has to be discussed with
6710!> the developers.
6711!>
6712!> If it is possible to call usm_allocate_surface before reading the restart file, this reading
6713!> routine would become much simpler, because no checking for allocation will be necessary any more.
6714!--------------------------------------------------------------------------------------------------!
6715 SUBROUTINE usm_rrd_local_mpi
6716
6717
6718    CHARACTER(LEN=1) ::  dum  !< dummy string to create input-variable name
6719
6720    INTEGER(iwp) ::  l  !< loop index for surface types
6721
6722    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  global_start
6723
6724    LOGICAL ::  ldum  !< dummy variable
6725
6726
6727    CALL rrd_mpi_io( 'usm_start_index_h',  surf_usm_h%start_index )
6728    CALL rrd_mpi_io( 'usm_end_index_h', surf_usm_h%end_index )
6729    CALL rrd_mpi_io( 'usm_global_start_h', global_start )
6730
6731    CALL rd_mpi_io_surface_filetypes( surf_usm_h%start_index, surf_usm_h%end_index, ldum,          &
6732                                      global_start )
6733
6734    IF ( .NOT.  ALLOCATED( t_surf_wall_h_1 ) )  ALLOCATE( t_surf_wall_h_1(1:surf_usm_h%ns) )
6735    CALL rrd_mpi_io_surface( 't_surf_wall_h', t_surf_wall_h_1 )
6736
6737    IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )  ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
6738    CALL rrd_mpi_io_surface( 't_surf_window_h', t_surf_window_h_1 )
6739
6740    IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )  ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
6741    CALL rrd_mpi_io_surface( 't_surf_green_h', t_surf_green_h_1 )
6742
6743    DO  l = 0, 3
6744
6745       WRITE( dum, '(I1)' )  l
6746
6747       CALL rrd_mpi_io( 'usm_start_index_v_' //dum, surf_usm_v(l)%start_index )
6748       CALL rrd_mpi_io( 'usm_end_index_v_' // dum, surf_usm_v(l)%end_index )
6749       CALL rrd_mpi_io( 'usm_global_start_v_' // dum, global_start )
6750
6751       CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index, ldum, &
6752                                         global_start )
6753
6754       IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(l)%t ) )                                             &
6755          ALLOCATE( t_surf_wall_v_1(l)%t(1:surf_usm_v(l)%ns) )
6756       CALL rrd_mpi_io_surface( 't_surf_wall_v(' // dum // ')', t_surf_wall_v_1(l)%t )
6757
6758       IF ( .NOT.  ALLOCATED( t_surf_window_v_1(l)%t ) )                                           &
6759          ALLOCATE( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
6760       CALL rrd_mpi_io_surface( 't_surf_window_v(' // dum // ')', t_surf_window_v_1(l)%t )
6761
6762       IF ( .NOT.  ALLOCATED( t_surf_green_v_1(l)%t ) )                                            &
6763          ALLOCATE( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
6764       CALL rrd_mpi_io_surface( 't_surf_green_v(' // dum // ')', t_surf_green_v_1(l)%t)
6765
6766    ENDDO
6767
6768    CALL rrd_mpi_io( 'usm_start_index_h_2',  surf_usm_h%start_index )
6769    CALL rrd_mpi_io( 'usm_end_index_h_2', surf_usm_h%end_index )
6770    CALL rrd_mpi_io( 'usm_global_start_h_2', global_start )
6771
6772    CALL rd_mpi_io_surface_filetypes( surf_usm_h%start_index, surf_usm_h%end_index, ldum,          &
6773                                      global_start )
6774
6775    IF ( .NOT.  ALLOCATED( t_wall_h_1 ) )                                                          &
6776       ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
6777    CALL rrd_mpi_io_surface( 't_wall_h', t_wall_h_1 )
6778
6779    IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                                                        &
6780       ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
6781    CALL rrd_mpi_io_surface( 't_window_h', t_window_h_1 )
6782
6783    IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                                                         &
6784       ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
6785    CALL rrd_mpi_io_surface( 't_green_h', t_green_h_1 )
6786
6787    DO  l = 0, 3
6788
6789       WRITE( dum, '(I1)' )  l
6790
6791       CALL rrd_mpi_io( 'usm_start_index_v_2_' //dum, surf_usm_v(l)%start_index )
6792       CALL rrd_mpi_io( 'usm_end_index_v_2_' // dum, surf_usm_v(l)%end_index )
6793       CALL rrd_mpi_io( 'usm_global_start_v_2_' // dum, global_start )
6794
6795       CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index, ldum, &
6796                                         global_start )
6797
6798       IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) )                                                   &
6799          ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
6800       CALL rrd_mpi_io_surface( 't_wall_v(' // dum // ')', t_wall_v_1(l)%t )
6801
6802       IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                                                 &
6803          ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
6804       CALL rrd_mpi_io_surface( 't_window_v(' // dum // ')', t_window_v_1(l)%t )
6805
6806       IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                                                  &
6807          ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
6808       CALL rrd_mpi_io_surface( 't_green_v(' // dum // ')', t_green_v_1(l)%t )
6809
6810    ENDDO
6811
6812 END SUBROUTINE usm_rrd_local_mpi
6813
6814
6815
6816!--------------------------------------------------------------------------------------------------!
6817! Description:
6818! ------------
6819!
6820!> This subroutine reads walls, roofs and land categories and its parameters from input files.
6821!--------------------------------------------------------------------------------------------------!
6822 SUBROUTINE usm_read_urban_surface_types
6823
6824    USE netcdf_data_input_mod,                                                                     &
6825        ONLY:  building_pars_f,                                                                    &
6826               building_type_f
6827
6828    IMPLICIT NONE
6829
6830    CHARACTER(12)                                        ::  wtn  !<
6831
6832    INTEGER(iwp)                                         ::  i, j                                  !<
6833    INTEGER(iwp)                                         ::  ii, ij, ip, it, iw, jw, k, kw, l, m   !<
6834    INTEGER(iwp)                                         ::  category                              !<
6835    INTEGER(iwp)                                         ::  dirsn, dirwe, nz, roof                !<
6836    INTEGER(iwp)                                         ::  weheight1, wecat1, snheight1, sncat1  !<
6837    INTEGER(iwp)                                         ::  weheight2, wecat2, snheight2, sncat2  !<
6838    INTEGER(iwp)                                         ::  weheight3, wecat3, snheight3, sncat3  !<
6839    INTEGER(iwp)                                         ::  wtc                                   !<
6840
6841    INTEGER(iwp), DIMENSION(0:17, nysg:nyng, nxlg:nxrg)  ::  usm_par  !<
6842
6843    LOGICAL                                              ::  ascii_file = .FALSE.  !<
6844
6845    REAL(wp)                                             ::  albedo, height, thick                     !<
6846    REAL(wp)                                             ::  wealbedo1, wethick1, snalbedo1, snthick1  !<
6847    REAL(wp)                                             ::  wealbedo2, wethick2, snalbedo2, snthick2  !<
6848    REAL(wp)                                             ::  wealbedo3, wethick3, snalbedo3, snthick3  !<
6849
6850    REAL(wp), DIMENSION(n_surface_params)                ::  wtp      !<
6851
6852    REAL(wp), DIMENSION(1:14, nysg:nyng, nxlg:nxrg)      ::  usm_val  !<
6853
6854
6855    IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'start' )
6856!
6857!-- If building_pars or building_type are already read from static input file, skip reading ASCII
6858!-- file.
6859    IF ( building_type_f%from_file  .OR.  building_pars_f%from_file )  RETURN
6860!
6861!-- Check if ASCII input file exists. If not, return and initialize USM with default settings.
6862    INQUIRE( FILE = 'SURFACE_PARAMETERS' // coupling_char, EXIST = ascii_file )
6863
6864    IF ( .NOT. ascii_file )  RETURN
6865
6866!
6867!-- Read categories of walls and their parameters
6868    DO  ii = 0, io_blocks-1
6869        IF ( ii == io_group )  THEN
6870!
6871!--         Open urban surface file
6872            OPEN( 151, file = 'SURFACE_PARAMETERS' // coupling_char,  action = 'read', &
6873                       status = 'old', form = 'formatted', err = 15 )
6874!
6875!--         First test and get n_surface_types
6876            k = 0
6877            l = 0
6878            DO
6879               l = l+1
6880               READ( 151, *, err = 11, end = 12 )  wtc, wtp, wtn
6881               k = k+1
6882               CYCLE
6883 11            CONTINUE
6884            ENDDO
6885 12         n_surface_types = k
6886            ALLOCATE( surface_type_names(n_surface_types) )
6887            ALLOCATE( surface_type_codes(n_surface_types) )
6888            ALLOCATE( surface_params(n_surface_params, n_surface_types) )
6889!
6890!--         Real reading
6891            rewind( 151 )
6892            k = 0
6893            DO
6894               READ( 151, *, err = 13, end = 14 )  wtc, wtp, wtn
6895               k = k+1
6896               surface_type_codes(k) = wtc
6897               surface_params(:,k) = wtp
6898               surface_type_names(k) = wtn
6899               CYCLE
690013             WRITE( 6,'(i3,a,2i5)') myid, 'readparams2 error k = ', k
6901               FLUSH( 6 )
6902               CONTINUE
6903            ENDDO
6904 14         CLOSE(151)
6905            CYCLE
6906 15         message_string = 'file SURFACE_PARAMETERS' // TRIM( coupling_char ) // ' does not exist'
6907            CALL message( 'usm_read_urban_surface_types', 'PA0513', 1, 2, 0, 6, 0 )
6908        ENDIF
6909    ENDDO
6910
6911!
6912!-- Read types of surfaces
6913    usm_par = 0
6914    DO  ii = 0, io_blocks-1
6915       IF ( ii == io_group )  THEN
6916
6917!
6918!--         Open csv urban surface file
6919            OPEN( 151, file = 'URBAN_SURFACE' // TRIM( coupling_char ), action = 'read',           &
6920                  status = 'old', form = 'formatted', err = 23 )
6921
6922            l = 0
6923            DO
6924
6925               l = l+1
6926!
6927!--            i, j, height, nz, roof, dirwe, dirsn, category, soilcat,
6928!--            weheight1, wecat1, snheight1, sncat1, weheight2, wecat2, snheight2, sncat2,
6929!--            weheight3, wecat3, snheight3, sncat3
6930               READ( 151, *, err = 21, end = 25 )  i, j, height, nz, roof, dirwe, dirsn,           &
6931                                       category, albedo, thick,                                    &
6932                                       weheight1, wecat1, wealbedo1, wethick1,                     &
6933                                       weheight2, wecat2, wealbedo2, wethick2,                     &
6934                                       weheight3, wecat3, wealbedo3, wethick3,                     &
6935                                       snheight1, sncat1, snalbedo1, snthick1,                     &
6936                                       snheight2, sncat2, snalbedo2, snthick2,                     &
6937                                       snheight3, sncat3, snalbedo3, snthick3
6938
6939               IF ( i >= nxlg  .AND.  i <= nxrg  .AND.  j >= nysg  .AND.  j <= nyng )  THEN
6940!
6941!--                Write integer variables into array
6942                   usm_par(:,j,i) = (/1, nz, roof, dirwe, dirsn, category,                         &
6943                                     weheight1, wecat1, weheight2, wecat2, weheight3, wecat3,      &
6944                                     snheight1, sncat1, snheight2, sncat2, snheight3, sncat3 /)
6945!
6946!--                Write real values into array
6947                   usm_val(:,j,i) = (/ albedo, thick,                                              &
6948                                      wealbedo1, wethick1, wealbedo2, wethick2,                    &
6949                                      wealbedo3, wethick3, snalbedo1, snthick1,                    &
6950                                      snalbedo2, snthick2, snalbedo3, snthick3 /)
6951               ENDIF
6952               CYCLE
6953 21            WRITE( message_string, '(A,I5)') 'errors in file URBAN_SURFACE ' //                 &
6954                                                TRIM( coupling_char ) // ' on line ', l
6955               CALL message( 'usm_read_urban_surface_types', 'PA0512', 0, 1, 0, 6, 0 )
6956            ENDDO
6957
6958 23         message_string = 'file URBAN_SURFACE ' // TRIM( coupling_char ) // ' does not exist'
6959            CALL message( 'usm_read_urban_surface_types', 'PA0514', 1, 2, 0, 6, 0 )
6960
6961 25         CLOSE( 151 )
6962
6963        ENDIF
6964#if defined( __parallel )
6965        CALL MPI_BARRIER( comm2d, ierr )
6966#endif
6967    ENDDO
6968
6969!
6970!-- Check completeness and formal correctness of the data
6971    DO  i = nxlg, nxrg
6972        DO  j = nysg, nyng
6973            IF ( usm_par(0,j,i) /= 0  .AND.  (        &  !< incomplete data,supply default values later
6974                 usm_par(1,j,i) < nzb  .OR.           &
6975                 usm_par(1,j,i) > nzt  .OR.           &  !< incorrect height (nz < nzb  .OR.  nz > nzt)
6976                 usm_par(2,j,i) < 0  .OR.             &
6977                 usm_par(2,j,i) > 1  .OR.             &  !< incorrect roof sign
6978                 usm_par(3,j,i) < nzb-nzt  .OR.       &
6979                 usm_par(3,j,i) > nzt-nzb  .OR.       &  !< incorrect west-east wall direction sign
6980                 usm_par(4,j,i) < nzb-nzt  .OR.       &
6981                 usm_par(4,j,i) > nzt-nzb  .OR.       &  !< incorrect south-north wall direction sign
6982                 usm_par(6,j,i) < nzb  .OR.           &
6983                 usm_par(6,j,i) > nzt  .OR.           &  !< incorrect pedestrian level height for west-east wall
6984                 usm_par(8,j,i) > nzt  .OR.           &
6985                 usm_par(10,j,i) > nzt  .OR.          &  !< incorrect wall or roof level height for west-east wall
6986                 usm_par(12,j,i) < nzb  .OR.          &
6987                 usm_par(12,j,i) > nzt  .OR.          &  !< incorrect pedestrian level height for south-north wall
6988                 usm_par(14,j,i) > nzt  .OR.          &
6989                 usm_par(16,j,i) > nzt                &  !< incorrect wall or roof level height for south-north wall
6990                ) )  THEN
6991!
6992!--             Incorrect input data
6993                WRITE( message_string, '(A,2I5)' )                                                 &
6994                'missing or incorrect data in file URBAN_SURFACE' //  TRIM( coupling_char ) //     &
6995                ' for i,j=', i, j
6996                CALL message( 'usm_read_urban_surface', 'PA0504', 1, 2, 0, 6, 0 )
6997            ENDIF
6998
6999        ENDDO
7000    ENDDO
7001!
7002!-- Assign the surface types to the respective data type. First, for horizontal upward-facing
7003!-- surfaces. Further, set flag indicating that albedo is initialized via ASCI format, else it would
7004!-- be overwritten in the radiation model.
7005    surf_usm_h%albedo_from_ascii = .TRUE.
7006    DO  m = 1, surf_usm_h%ns
7007       iw = surf_usm_h%i(m)
7008       jw = surf_usm_h%j(m)
7009       kw = surf_usm_h%k(m)
7010
7011       IF ( usm_par(5,jw,iw) == 0 )  THEN
7012
7013          IF ( zu(kw) >= roof_height_limit )  THEN
7014             surf_usm_h%isroof_surf(m)   = .TRUE.
7015             surf_usm_h%surface_types(m) = roof_category !< Default category for root surface
7016          ELSE
7017             surf_usm_h%isroof_surf(m)   = .FALSE.
7018             surf_usm_h%surface_types(m) = land_category !< Default category for land surface
7019          ENDIF
7020
7021          surf_usm_h%albedo(m,:)         = -1.0_wp
7022          surf_usm_h%thickness_wall(m)   = -1.0_wp
7023          surf_usm_h%thickness_green(m)  = -1.0_wp
7024          surf_usm_h%thickness_window(m) = -1.0_wp
7025       ELSE
7026          IF ( usm_par(2,jw,iw)==0 )  THEN
7027             surf_usm_h%isroof_surf(m)      = .FALSE.
7028             surf_usm_h%thickness_wall(m)   = -1.0_wp
7029             surf_usm_h%thickness_window(m) = -1.0_wp
7030             surf_usm_h%thickness_green(m)  = -1.0_wp
7031          ELSE
7032             surf_usm_h%isroof_surf(m)      = .TRUE.
7033             surf_usm_h%thickness_wall(m)   = usm_val(2,jw,iw)
7034             surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
7035             surf_usm_h%thickness_green(m)  = usm_val(2,jw,iw)
7036          ENDIF
7037          surf_usm_h%surface_types(m)     = usm_par(5,jw,iw)
7038          surf_usm_h%albedo(m,:)          = usm_val(1,jw,iw)
7039          surf_usm_h%transmissivity(m)    = 0.0_wp
7040       ENDIF
7041!
7042!--    Find the type position
7043       it = surf_usm_h%surface_types(m)
7044       ip = -99999
7045       DO  k = 1, n_surface_types
7046          IF ( surface_type_codes(k) == it )  THEN
7047             ip = k
7048             EXIT
7049          ENDIF
7050       ENDDO
7051       IF ( ip == -99999 )  THEN
7052!
7053!--       Land/roof category not found
7054          WRITE(9, '(A, I5, A, 3I5)' ) 'land/roof category ', it, ' not found  for i, j, k = ',    &
7055                                       iw, jw, kw
7056          FLUSH( 9 )
7057          IF ( surf_usm_h%isroof_surf(m) )  THEN
7058             category = roof_category
7059          ELSE
7060             category = land_category
7061          ENDIF
7062          DO  k = 1, n_surface_types
7063             IF ( surface_type_codes(k) == roof_category )  THEN
7064                ip = k
7065                EXIT
7066             ENDIF
7067          ENDDO
7068          IF ( ip == -99999 )  THEN
7069!
7070!--          Default land/roof category not found
7071             WRITE( 9, '(A, I5, A, 3I5)' ) 'Default land/roof category ', category, ' not found!'
7072             FLUSH( 9 )
7073             ip = 1
7074          ENDIF
7075       ENDIF
7076!
7077!--    Albedo
7078       IF ( surf_usm_h%albedo(m,ind_veg_wall) < 0.0_wp )  THEN
7079          surf_usm_h%albedo(m,:) = surface_params(ialbedo, ip)
7080       ENDIF
7081!
7082!--    Albedo type is 0 (custom), others are replaced later
7083       surf_usm_h%albedo_type(m,:) = 0
7084!
7085!--    Transmissivity
7086       IF ( surf_usm_h%transmissivity(m) < 0.0_wp )  THEN
7087          surf_usm_h%transmissivity(m) = 0.0_wp
7088       ENDIF
7089!
7090!--    Emissivity of the wall
7091       surf_usm_h%emissivity(m,:) = surface_params(iemiss, ip)
7092!
7093!--    Heat conductivity λS between air and wall ( W m−2 K−1 )
7094       surf_usm_h%lambda_surf(m)        = surface_params(ilambdas,ip)
7095       surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
7096       surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
7097!
7098!--    Roughness length for momentum, heat and humidity
7099       surf_usm_h%z0(m)  = surface_params(irough,ip)
7100       surf_usm_h%z0h(m) = surface_params(iroughh,ip)
7101       surf_usm_h%z0q(m) = surface_params(iroughh,ip)
7102!
7103!--    Surface skin layer heat capacity (J m−2 K−1 )
7104       surf_usm_h%c_surface(m)        = surface_params(icsurf,ip)
7105       surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
7106       surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
7107!
7108!--    Wall material parameters:
7109!--    Thickness of the wall (m) missing values are replaced by default value for category
7110       IF ( surf_usm_h%thickness_wall(m) <= 0.001_wp )  THEN
7111            surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
7112       ENDIF
7113       IF ( surf_usm_h%thickness_window(m) <= 0.001_wp )  THEN
7114            surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
7115       ENDIF
7116       IF ( surf_usm_h%thickness_green(m) <= 0.001_wp )  THEN
7117            surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
7118       ENDIF
7119!
7120!--    Volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
7121       surf_usm_h%rho_c_wall(:,m)   = surface_params(irhoC,ip)
7122       surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
7123       surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
7124!
7125!--    Thermal conductivity λH of the wall (W m−1 K−1 )
7126       surf_usm_h%lambda_h(:,m)        = surface_params(ilambdah,ip)
7127       surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7128       surf_usm_h%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
7129
7130    ENDDO
7131!
7132!-- For vertical surface elements ( 0 -- northward-facing, 1 -- southward-facing,
7133!--  2 -- eastward-facing, 3 -- westward-facing )
7134    DO  l = 0, 3
7135!
7136!--    Set flag indicating that albedo is initialized via ASCII format.
7137!--    Else it would be overwritten in the radiation model.
7138       surf_usm_v(l)%albedo_from_ascii = .TRUE.
7139       DO  m = 1, surf_usm_v(l)%ns
7140          i  = surf_usm_v(l)%i(m)
7141          j  = surf_usm_v(l)%j(m)
7142          kw = surf_usm_v(l)%k(m)
7143
7144          IF ( l == 3 )  THEN ! Westward facing
7145             iw = i
7146             jw = j
7147             ii = 6
7148             ij = 3
7149          ELSEIF ( l == 2 )  THEN
7150             iw = i-1
7151             jw = j
7152             ii = 6
7153             ij = 3
7154          ELSEIF ( l == 1 )  THEN
7155             iw = i
7156             jw = j
7157             ii = 12
7158             ij = 9
7159          ELSEIF ( l == 0 )  THEN
7160             iw = i
7161             jw = j-1
7162             ii = 12
7163             ij = 9
7164          ENDIF
7165
7166          IF ( iw < 0 .OR. jw < 0 ) THEN
7167!
7168!--          Wall on west or south border of the domain - assign default category
7169             IF ( kw <= roof_height_limit ) THEN
7170                 surf_usm_v(l)%surface_types(m) = wall_category   !< Default category for wall surface in wall zone
7171             ELSE
7172                 surf_usm_v(l)%surface_types(m) = roof_category   !< Default category for wall surface in roof zone
7173             ENDIF
7174             surf_usm_v(l)%albedo(m,:)         = -1.0_wp
7175             surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7176             surf_usm_v(l)%thickness_window(m) = -1.0_wp
7177             surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7178             surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7179          ELSE IF ( kw <= usm_par(ii,jw,iw) )  THEN
7180!
7181!--             Pedestrian zone
7182             IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
7183                 surf_usm_v(l)%surface_types(m)  = pedestrian_category   !< Default category for wall surface in
7184                                                                         !< Pedestrian zone
7185                 surf_usm_v(l)%albedo(m,:)         = -1.0_wp
7186                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7187                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7188                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7189                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7190             ELSE
7191                 surf_usm_v(l)%surface_types(m)    = usm_par(ii+1,jw,iw)
7192                 surf_usm_v(l)%albedo(m,:)         = usm_val(ij,jw,iw)
7193                 surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+1,jw,iw)
7194                 surf_usm_v(l)%thickness_window(m) = usm_val(ij+1,jw,iw)
7195                 surf_usm_v(l)%thickness_green(m)  = usm_val(ij+1,jw,iw)
7196                 surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7197             ENDIF
7198          ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
7199!
7200!--          Wall zone
7201             IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
7202                 surf_usm_v(l)%surface_types(m)    = wall_category  !< default category for wall surface
7203                 surf_usm_v(l)%albedo(m,:)         = -1.0_wp
7204                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7205                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7206                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7207                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7208             ELSE
7209                 surf_usm_v(l)%surface_types(m)    = usm_par(ii+3,jw,iw)
7210                 surf_usm_v(l)%albedo(m,:)         = usm_val(ij+2,jw,iw)
7211                 surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+3,jw,iw)
7212                 surf_usm_v(l)%thickness_window(m) = usm_val(ij+3,jw,iw)
7213                 surf_usm_v(l)%thickness_green(m)  = usm_val(ij+3,jw,iw)
7214                 surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7215             ENDIF
7216          ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
7217!
7218!--          Roof zone
7219             IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
7220                 surf_usm_v(l)%surface_types(m)    = roof_category  !< Default category for roof surface
7221                 surf_usm_v(l)%albedo(m,:)         = -1.0_wp
7222                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7223                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7224                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7225                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7226             ELSE
7227                 surf_usm_v(l)%surface_types(m)    = usm_par(ii+5,jw,iw)
7228                 surf_usm_v(l)%albedo(m,:)         = usm_val(ij+4,jw,iw)
7229                 surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+5,jw,iw)
7230                 surf_usm_v(l)%thickness_window(m) = usm_val(ij+5,jw,iw)
7231                 surf_usm_v(l)%thickness_green(m)  = usm_val(ij+5,jw,iw)
7232                 surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7233             ENDIF
7234          ELSE
7235             WRITE( 9, *) 'Problem reading USM data:'
7236             WRITE( 9, *) l,i,j,kw,topo_top_ind(j,i,0)
7237             WRITE( 9, *) ii,iw,jw,kw,topo_top_ind(jw,iw,0)
7238             WRITE( 9, *) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw)
7239             WRITE( 9, *) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw)
7240             WRITE( 9, *) usm_par(ii+4,jw,iw),usm_par(ii+5,jw,iw)
7241             WRITE( 9, *) kw,roof_height_limit,wall_category,roof_category
7242             FLUSH( 9 )
7243!
7244!--          Supply the default category
7245             IF ( kw <= roof_height_limit )  THEN
7246                 surf_usm_v(l)%surface_types(m) = wall_category  !< Default category for wall surface in wall zone
7247             ELSE
7248                 surf_usm_v(l)%surface_types(m) = roof_category  !< Default category for wall surface in roof zone
7249             ENDIF
7250             surf_usm_v(l)%albedo(m,:)         = -1.0_wp
7251             surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7252             surf_usm_v(l)%thickness_window(m) = -1.0_wp
7253             surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7254             surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7255          ENDIF
7256!
7257!--       Find the type position
7258          it = surf_usm_v(l)%surface_types(m)
7259          ip = -99999
7260          DO  k = 1, n_surface_types
7261             IF ( surface_type_codes(k) == it )  THEN
7262                ip = k
7263                EXIT
7264             ENDIF
7265          ENDDO
7266          IF ( ip == -99999 )  THEN
7267!
7268!--          Wall category not found
7269             WRITE( 9, '(A,I7,A,3I5)' ) 'wall category ', it, ' not found  for i,j,k = ', iw, jw, kw
7270             FLUSH(9)
7271             category = wall_category
7272             DO  k = 1, n_surface_types
7273                IF ( surface_type_codes(k) == category )  THEN
7274                   ip = k
7275                   EXIT
7276                ENDIF
7277             ENDDO
7278             IF ( ip == -99999 )  THEN
7279!
7280!--             Default wall category not found
7281                WRITE ( 9, '(A,I5,A,3I5)' ) 'Default wall category', category, ' not found!'
7282                FLUSH( 9 )
7283                ip = 1
7284             ENDIF
7285          ENDIF
7286
7287!
7288!--       Albedo
7289          IF ( surf_usm_v(l)%albedo(m,ind_veg_wall) < 0.0_wp )  THEN
7290             surf_usm_v(l)%albedo(m,:) = surface_params(ialbedo,ip)
7291          ENDIF
7292!--       Albedo type is 0 (custom), others are replaced later
7293          surf_usm_v(l)%albedo_type(m,:) = 0
7294!--       Transmissivity of the windows
7295          IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp )  THEN
7296             surf_usm_v(l)%transmissivity(m) = 0.0_wp
7297          ENDIF
7298!
7299!--       Emissivity of the wall
7300          surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
7301!
7302!--       Heat conductivity lambda S between air and wall ( W m-2 K-1 )
7303          surf_usm_v(l)%lambda_surf(m)        = surface_params(ilambdas,ip)
7304          surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
7305          surf_usm_v(l)%lambda_surf_green(m)  = surface_params(ilambdas,ip)
7306!
7307!--       Roughness length
7308          surf_usm_v(l)%z0(m)  = surface_params(irough,ip)
7309          surf_usm_v(l)%z0h(m) = surface_params(iroughh,ip)
7310          surf_usm_v(l)%z0q(m) = surface_params(iroughh,ip)
7311!
7312!--       Surface skin layer heat capacity (J m-2 K-1 )
7313          surf_usm_v(l)%c_surface(m)        = surface_params(icsurf,ip)
7314          surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
7315          surf_usm_v(l)%c_surface_green(m)  = surface_params(icsurf,ip)
7316!
7317!--       Wall material parameters:
7318!--       Thickness of the wall (m)
7319!--       Missing values are replaced by default value for category
7320          IF ( surf_usm_v(l)%thickness_wall(m) <= 0.001_wp )  THEN
7321               surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
7322          ENDIF
7323          IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp )  THEN
7324               surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
7325          ENDIF
7326          IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp )  THEN
7327               surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
7328          ENDIF
7329!
7330!--       Volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
7331          surf_usm_v(l)%rho_c_wall(:,m)   = surface_params(irhoC,ip)
7332          surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
7333          surf_usm_v(l)%rho_c_green(:,m)  = surface_params(irhoC,ip)
7334!
7335!--       Thermal conductivity lambda H of the wall (W m-1 K-1 )
7336          surf_usm_v(l)%lambda_h(:,m)        = surface_params(ilambdah,ip)
7337          surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7338          surf_usm_v(l)%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
7339
7340       ENDDO
7341    ENDDO
7342
7343!
7344!-- Initialize wall layer thicknesses. Please note, this will be removed after migration to Palm
7345!-- input data standard.
7346    DO  k = nzb_wall, nzt_wall
7347       zwn(k)        = zwn_default(k)
7348       zwn_green(k)  = zwn_default_green(k)
7349       zwn_window(k) = zwn_default_window(k)
7350    ENDDO
7351!
7352!-- Apply for all particular surface grids. First for horizontal surfaces
7353    DO  m = 1, surf_usm_h%ns
7354       surf_usm_h%zw(:,m)        = zwn(:) * surf_usm_h%thickness_wall(m)
7355       surf_usm_h%zw_green(:,m)  = zwn_green(:) * surf_usm_h%thickness_green(m)
7356       surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
7357    ENDDO
7358    DO  l = 0, 3
7359       DO  m = 1, surf_usm_v(l)%ns
7360          surf_usm_v(l)%zw(:,m)        = zwn(:) * surf_usm_v(l)%thickness_wall(m)
7361          surf_usm_v(l)%zw_green(:,m)  = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
7362          surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
7363       ENDDO
7364    ENDDO
7365
7366    IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'end' )
7367
7368 END SUBROUTINE usm_read_urban_surface_types
7369
7370
7371!--------------------------------------------------------------------------------------------------!
7372! Description:
7373! ------------
7374!
7375!> This function advances through the list of local surfaces to find given x, y, d, z coordinates
7376!--------------------------------------------------------------------------------------------------!
7377    PURE FUNCTION find_surface( x, y, z, d ) result(isurfl)
7378
7379        INTEGER(iwp)              ::  isurfl         !<
7380        INTEGER(iwp)              ::  isx, isy, isz  !<
7381        INTEGER(iwp), INTENT(in)  ::  d, x, y, z     !<
7382
7383        IF ( d == 0 )  THEN
7384           DO  isurfl = 1, surf_usm_h%ns
7385              isx = surf_usm_h%i(isurfl)
7386              isy = surf_usm_h%j(isurfl)
7387              isz = surf_usm_h%k(isurfl)
7388              IF ( isx==x .AND. isy==y .AND. isz==z )  RETURN
7389           ENDDO
7390        ELSE
7391           DO  isurfl = 1, surf_usm_v(d-1)%ns
7392              isx = surf_usm_v(d-1)%i(isurfl)
7393              isy = surf_usm_v(d-1)%j(isurfl)
7394              isz = surf_usm_v(d-1)%k(isurfl)
7395              IF ( isx==x .AND. isy==y .AND. isz==z )  RETURN
7396           ENDDO
7397        ENDIF
7398!
7399!--     coordinate not found
7400        isurfl = -1
7401
7402    END FUNCTION
7403
7404
7405!--------------------------------------------------------------------------------------------------!
7406! Description:
7407! ------------
7408!
7409!> This subroutine reads temperatures of respective material layers in walls, roofs and ground from
7410!> input files. Data in the input file must be in standard order, i.e. horizontal surfaces first
7411!> ordered by x, y and then vertical surfaces ordered by x, y, direction, z
7412!--------------------------------------------------------------------------------------------------!
7413 SUBROUTINE usm_read_wall_temperature
7414
7415    INTEGER(iwp)                              ::  d, i, ii, iline, j, k  !< running indices
7416    INTEGER(iwp)                              ::  isurfl                 !<
7417
7418    REAL(wp)                                  ::  rtsurf  !<
7419    REAL(wp), DIMENSION(nzb_wall:nzt_wall+1)  ::  rtwall  !<
7420
7421
7422    IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'start' )
7423
7424    DO  ii = 0, io_blocks-1
7425        IF ( ii == io_group )  THEN
7426!
7427!--         Open wall temperature file
7428            OPEN( 152, file = 'WALL_TEMPERATURE' // coupling_char, action = 'read', &
7429                       status = 'old', form = 'formatted', err = 15 )
7430
7431            isurfl = 0
7432            iline = 1
7433            DO
7434                rtwall = -9999.0_wp  !< For incomplete lines
7435                READ( 152, *, err = 13, end = 14 )  i, j, k, d, rtsurf, rtwall
7436
7437                IF ( nxl <= i .AND. i <= nxr .AND. nys <= j .AND. j <= nyn)  THEN  !< Local processor
7438!--                 identify surface id
7439                    isurfl = find_surface( i, j, k, d )
7440                    IF ( isurfl == -1 )  THEN
7441                        WRITE( message_string, '(a,4i5,a,i5,a)' ) 'Coordinates (xyzd) ', i, j, k,  &
7442                        d, ' on line ', iline, ' in file WALL_TEMPERATURE are either not ' //      &
7443                        'present or out of standard order of surfaces.'
7444                        CALL message( 'usm_read_wall_temperature', 'PA0521', 1, 2, 0, 6, 0 )
7445                    ENDIF
7446!
7447!--                 Assign temperatures
7448                    IF ( d == 0 )  THEN
7449                       t_surf_wall_h(isurfl) = rtsurf
7450                       t_wall_h(:,isurfl)    = rtwall(:)
7451                       t_window_h(:,isurfl)  = rtwall(:)
7452                       t_green_h(:,isurfl)   = rtwall(:)
7453                    ELSE
7454                       t_surf_wall_v(d-1)%t(isurfl) = rtsurf
7455                       t_wall_v(d-1)%t(:,isurfl)    = rtwall(:)
7456                       t_window_v(d-1)%t(:,isurfl)  = rtwall(:)
7457                       t_green_v(d-1)%t(:,isurfl)   = rtwall(:)
7458                    ENDIF
7459                ENDIF
7460
7461                iline = iline + 1
7462                CYCLE
7463 13             WRITE( message_string, '(a,i5,a)' ) 'Error reading line ', iline,                  &
7464                                                    ' in file WALL_TEMPERATURE.'
7465                CALL message( 'usm_read_wall_temperature', 'PA0522', 1, 2, 0, 6, 0 )
7466            ENDDO
7467 14         CLOSE( 152 )
7468            CYCLE
7469 15         message_string = 'file WALL_TEMPERATURE' // TRIM( coupling_char ) // ' does not exist'
7470            CALL message( 'usm_read_wall_temperature', 'PA0523', 1, 2, 0, 6, 0 )
7471        ENDIF
7472#if defined( __parallel )
7473        CALL MPI_BARRIER( comm2d, ierr )
7474#endif
7475    ENDDO
7476
7477    IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'end' )
7478
7479 END SUBROUTINE usm_read_wall_temperature
7480
7481
7482
7483!--------------------------------------------------------------------------------------------------!
7484! Description:
7485! ------------
7486!> Solver for the energy balance at the ground/roof/wall surface. It follows the basic ideas and
7487!> structure of lsm_energy_balance with many simplifications and adjustments.
7488!> TODO better description
7489!> No calculation of window surface temperatures during spinup to increase maximum possible timstep
7490!--------------------------------------------------------------------------------------------------!
7491 SUBROUTINE usm_surface_energy_balance( during_spinup )
7492
7493    USE exchange_horiz_mod,                                                                        &
7494        ONLY:  exchange_horiz
7495
7496
7497    IMPLICIT NONE
7498
7499    INTEGER(iwp)  ::  dhour          !< simulated hour of day (in UTC)
7500    INTEGER(iwp)  ::  i, j, k, l, m  !< running indices
7501    INTEGER(iwp)  ::  i_off  !< offset to determine index of surface element, seen from atmospheric grid point, for x
7502    INTEGER(iwp)  ::  j_off  !< offset to determine index of surface element, seen from atmospheric grid point, for y
7503    INTEGER(iwp)  ::  k_off  !< offset to determine index of surface element, seen from atmospheric grid point, for z
7504
7505    LOGICAL  ::  during_spinup      !< flag indicating soil/wall spinup phase
7506
7507    REAL(wp)  ::  acoef              !< actual coefficient of diurnal profile of anthropogenic heat
7508    REAL(wp)  ::  coef_1             !< first coeficient for prognostic equation
7509    REAL(wp)  ::  coef_window_1      !< first coeficient for prognostic window equation
7510    REAL(wp)  ::  coef_green_1       !< first coeficient for prognostic green wall equation
7511    REAL(wp)  ::  coef_2             !< second  coeficient for prognostic equation
7512    REAL(wp)  ::  coef_window_2      !< second  coeficient for prognostic window equation
7513    REAL(wp)  ::  coef_green_2       !< second  coeficient for prognostic green wall equation
7514    REAL(wp)  ::  dtime              !< simulated time of day (in UTC)
7515    REAL(wp)  ::  frac_win           !< window fraction, used to restore original values during spinup
7516    REAL(wp)  ::  frac_green         !< green fraction, used to restore original values during spinup
7517    REAL(wp)  ::  frac_wall          !< wall fraction, used to restore original values during spinup
7518    REAL(wp)  ::  f_shf              !< factor for shf_eb
7519    REAL(wp)  ::  f_shf_window       !< factor for shf_eb window
7520    REAL(wp)  ::  f_shf_green        !< factor for shf_eb green wall
7521    REAL(wp)  ::  lambda_surface     !< current value of lambda_surface (heat conductivity
7522                                     !<between air and wall)
7523    REAL(wp)  ::  lambda_surface_window  !< current value of lambda_surface (heat conductivity
7524                                         !< between air and window)
7525    REAL(wp)  ::  lambda_surface_green   !< current value of lambda_surface (heat conductivity
7526                                                                    !< between air and greeb wall)
7527    REAL(wp)  ::  rho_cp             !< rho_wall_surface * c_p
7528    REAL(wp)  ::  stend_wall         !< surface tendency
7529    REAL(wp)  ::  stend_window       !< surface tendency
7530    REAL(wp)  ::  stend_green        !< surface tendency
7531
7532
7533    REAL(wp)  ::  dq_s_dt,                 &  !< derivate of q_s with respect to T
7534                  drho_l_lv,               &  !< frequently used parameter for green layers
7535                  e,                       &  !< water vapour pressure
7536                  e_s,                     &  !< water vapour saturation pressure
7537                  e_s_dt,                  &  !< derivate of e_s with respect to T
7538                  f_qsws,                  &  !< factor for qsws
7539                  f_qsws_veg,              &  !< factor for qsws_veg
7540                  f_qsws_liq,              &  !< factor for qsws_liq
7541                  f1,                      &  !< resistance correction term 1
7542                  f2,                      &  !< resistance correction term 2
7543                  f3,                      &  !< resistance correction term 3
7544                  m_max_depth = 0.0002_wp, &  !< Maximum capacity of the water reservoir (m)
7545                  m_liq_max,               &  !< maxmimum value of the liq. water reservoir
7546                  qv1,                     &  !< specific humidity at first grid level
7547                  q_s,                     &  !< saturation specific humidity
7548                  rho_lv,                  &  !< frequently used parameter for green layers
7549                  tend,                    &  !< tendency
7550                  ueff                        !< limited near-surface wind speed - used for calculation of resistance
7551
7552
7553    IF ( debug_output_timestep )  THEN
7554       WRITE( debug_string, * ) 'usm_surface_energy_balance | during_spinup: ', during_spinup
7555       CALL debug_message( debug_string, 'start' )
7556    ENDIF
7557!
7558!-- Index offset of surface element point with respect to adjoining atmospheric grid point
7559    k_off = surf_usm_h%koff
7560    j_off = surf_usm_h%joff
7561    i_off = surf_usm_h%ioff
7562
7563!
7564!-- First, treat horizontal surface elements
7565    !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_surface, lambda_surface_window,                      &
7566    !$OMP&                  lambda_surface_green, qv1, rho_cp, rho_lv, drho_l_lv, f_shf,            &
7567    !$OMP&                  f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, f3, f_qsws_veg,     &
7568    !$OMP&                  q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, coef_window_1,        &
7569    !$OMP&                  coef_green_1, coef_2, coef_window_2, coef_green_2, stend_wall,          &
7570    !$OMP&                  stend_window, stend_green, tend, m_liq_max)
7571    !$OMP DO SCHEDULE (STATIC)
7572    DO  m = 1, surf_usm_h%ns
7573!
7574!--    During spinup set green and window fraction to zero and restore at the end of the loop.
7575!--    Note, this is a temporary fix and needs to be removed later.
7576       IF ( during_spinup )  THEN
7577          frac_win                         = surf_usm_h%frac(m,ind_wat_win)
7578          frac_wall                        = surf_usm_h%frac(m,ind_veg_wall)
7579          frac_green                       = surf_usm_h%frac(m,ind_pav_green)
7580          surf_usm_h%frac(m,ind_wat_win)   = 0.0_wp
7581          surf_usm_h%frac(m,ind_veg_wall)  = 1.0_wp
7582          surf_usm_h%frac(m,ind_pav_green) = 0.0_wp
7583       ENDIF
7584!
7585!--    Get indices of respective grid point
7586       i = surf_usm_h%i(m)
7587       j = surf_usm_h%j(m)
7588       k = surf_usm_h%k(m)
7589!
7590!--    TODO - how to calculate lambda_surface for horizontal surfaces
7591!--    (lambda_surface is set according to stratification in land surface model)
7592!--    MS: ???
7593       IF ( surf_usm_h%ol(m) >= 0.0_wp )  THEN
7594          lambda_surface        = surf_usm_h%lambda_surf(m)
7595          lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7596          lambda_surface_green  = surf_usm_h%lambda_surf_green(m)
7597       ELSE
7598          lambda_surface        = surf_usm_h%lambda_surf(m)
7599          lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7600          lambda_surface_green  = surf_usm_h%lambda_surf_green(m)
7601       ENDIF
7602
7603!        pt1  = pt(k,j,i)
7604       IF ( humidity )  THEN
7605          qv1 = q(k,j,i)
7606       ELSE
7607          qv1 = 0.0_wp
7608       ENDIF
7609!
7610!--    Calculate rho * c_p coefficient at surface layer
7611       rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exner(k) )
7612
7613       IF ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp )  THEN
7614!
7615!--       Calculate frequently used parameters
7616          rho_lv    = rho_cp / c_p * l_v
7617          drho_l_lv = 1.0_wp / ( rho_l * l_v )
7618       ENDIF
7619
7620!
7621!--    Calculate aerodyamic resistance.
7622!--    Calculation for horizontal surfaces follows LSM formulation pt, us, ts are not available for
7623!--    the prognostic time step, data from the last time step is used here.
7624!
7625!--    Workaround: use single r_a as stability is only treated for the average temperature
7626       surf_usm_h%r_a(m)        = ( surf_usm_h%pt1(m) - surf_usm_h%pt_surface(m) ) /               &
7627                                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7628       surf_usm_h%r_a_window(m) = surf_usm_h%r_a(m)
7629       surf_usm_h%r_a_green(m)  = surf_usm_h%r_a(m)
7630
7631!        r_a        = ( surf_usm_h%pt1(m) - t_surf_h(m) / exner(k) ) /                              &
7632!                     ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7633!        r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exner(k) ) /                       &
7634!                     ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7635!        r_a_green  = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /                        &
7636!                     ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7637
7638!--    Make sure that the resistance does not drop to zero
7639       IF ( surf_usm_h%r_a(m)        < 1.0_wp )  surf_usm_h%r_a(m)        = 1.0_wp
7640       IF ( surf_usm_h%r_a_green(m)  < 1.0_wp )  surf_usm_h%r_a_green(m)  = 1.0_wp
7641       IF ( surf_usm_h%r_a_window(m) < 1.0_wp )  surf_usm_h%r_a_window(m) = 1.0_wp
7642
7643!
7644!--    Make sure that the resistacne does not exceed a maxmium value in case of zero velocities
7645       IF ( surf_usm_h%r_a(m)        > 300.0_wp )  surf_usm_h%r_a(m)        = 300.0_wp
7646       IF ( surf_usm_h%r_a_green(m)  > 300.0_wp )  surf_usm_h%r_a_green(m)  = 300.0_wp
7647       IF ( surf_usm_h%r_a_window(m) > 300.0_wp )  surf_usm_h%r_a_window(m) = 300.0_wp
7648
7649!
7650!--    Factor for shf_eb
7651       f_shf         = rho_cp / surf_usm_h%r_a(m)
7652       f_shf_window  = rho_cp / surf_usm_h%r_a_window(m)
7653       f_shf_green   = rho_cp / surf_usm_h%r_a_green(m)
7654
7655
7656       IF ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp )  THEN
7657!--       Adapted from LSM:
7658!--       Second step: calculate canopy resistance r_canopy f1-f3 here are defined as 1/f1-f3 as in
7659!--       ECMWF documentation
7660
7661!--       f1: Correction for incoming shortwave radiation (stomata close at night)
7662          f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 0.05_wp ) /                     &
7663                    (0.81_wp * ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 1.0_wp ) ) )
7664!
7665!--       f2: Correction for soil moisture availability to plants (the integrated soil moisture must
7666!--       thus be considered here) f2 = 0 for very dry soils
7667          m_total = 0.0_wp
7668          DO  k = nzb_wall, nzt_wall+1
7669              m_total = m_total + rootfr_h(nzb_wall,m) * MAX( swc_h(nzb_wall,m),wilt_h(nzb_wall,m) )
7670          ENDDO
7671
7672          IF ( m_total > wilt_h(nzb_wall,m)  .AND.  m_total < fc_h(nzb_wall,m) )  THEN
7673             f2 = ( m_total - wilt_h(nzb_wall,m) ) / (fc_h(nzb_wall,m) - wilt_h(nzb_wall,m) )
7674          ELSEIF ( m_total >= fc_h(nzb_wall,m) )  THEN
7675             f2 = 1.0_wp
7676          ELSE
7677             f2 = 1.0E-20_wp
7678          ENDIF
7679
7680!
7681!--       Calculate water vapour pressure at saturation
7682          e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_h(m) - 273.16_wp )           &
7683                                           / ( t_surf_green_h(m) - 35.86_wp ) )
7684!
7685!--       f3: Correction for vapour pressure deficit
7686          IF ( surf_usm_h%g_d(m) /= 0.0_wp )  THEN
7687!
7688!--       Calculate vapour pressure
7689             e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
7690             f3 = EXP ( - surf_usm_h%g_d(m) * (e_s - e) )
7691          ELSE
7692             f3 = 1.0_wp
7693          ENDIF
7694
7695!
7696!--       Calculate canopy resistance. In case that c_veg is 0 (bare soils), this calculation is
7697!--       obsolete, as r_canopy is not used below.
7698!--       To do: check for very dry soil -> r_canopy goes to infinity
7699          surf_usm_h%r_canopy(m) = surf_usm_h%r_canopy_min(m) /                                    &
7700                                  ( surf_usm_h%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
7701
7702!
7703!--       Calculate the maximum possible liquid water amount on plants and bare surface. For
7704!--       vegetated surfaces, a maximum depth of 0.2 mm is assumed, while paved surfaces might hold
7705!--       up 1 mm of water. The liquid water fraction for paved surfaces is calculated after
7706!--       Noilhan & Planton (1989), while the ECMWF formulation is used for vegetated surfaces and
7707!--       bare soils.
7708          m_liq_max = m_max_depth * ( surf_usm_h%lai(m) )
7709
7710          surf_usm_h%c_liq(m) = MIN( 1.0_wp, ( m_liq_usm_h%var_usm_1d(m) / m_liq_max )**0.67 )
7711!
7712!--       Calculate saturation specific humidity
7713          q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
7714!
7715!--       In case of dewfall, set evapotranspiration to zero
7716!--       All super-saturated water is then removed from the air
7717          IF ( humidity  .AND.  q_s <= qv1 )  THEN
7718             surf_usm_h%r_canopy(m) = 0.0_wp
7719          ENDIF
7720
7721!
7722!--       Calculate coefficients for the total evapotranspiration
7723!--       In case of water surface, set vegetation and soil fluxes to zero.
7724!--       For pavements, only evaporation of liquid water is possible.
7725          f_qsws_veg  = rho_lv * ( 1.0_wp - surf_usm_h%c_liq(m) ) /                                &
7726                        ( surf_usm_h%r_a_green(m) + surf_usm_h%r_canopy(m) )
7727          f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m) / surf_usm_h%r_a_green(m)
7728
7729          f_qsws = f_qsws_veg + f_qsws_liq
7730!
7731!--       Calculate derivative of q_s for Taylor series expansion
7732          e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_h(m) - 35.86_wp ) - 17.269_wp                &
7733                   * ( t_surf_green_h(m) - 273.16_wp ) / ( t_surf_green_h(m) - 35.86_wp )**2 )
7734
7735          dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
7736       ENDIF
7737!
7738!--    Add LW up so that it can be removed in prognostic equation
7739       surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  - surf_usm_h%rad_sw_out(m) +             &
7740                                 surf_usm_h%rad_lw_in(m)  - surf_usm_h%rad_lw_out(m)
7741!
7742!--    Numerator of the prognostic equation
7743!--    Todo: Adjust to tile approach. So far, emissivity for wall (element 0) is used
7744       coef_1 = surf_usm_h%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                      &
7745               * surf_usm_h%emissivity(m,ind_veg_wall) * sigma_sb * t_surf_wall_h(m)**4            &
7746               + f_shf * surf_usm_h%pt1(m) + lambda_surface * t_wall_h(nzb_wall,m)
7747
7748       IF ( ( .NOT. during_spinup ) .AND. (surf_usm_h%frac(m,ind_wat_win) > 0.0_wp ) )  THEN
7749          coef_window_1 = surf_usm_h%rad_net_l(m) +  ( 3.0_wp + 1.0_wp )                           &
7750                          * surf_usm_h%emissivity(m,ind_wat_win) * sigma_sb                        &
7751                          * t_surf_window_h(m)**4 + f_shf_window * surf_usm_h%pt1(m)               &
7752                          + lambda_surface_window * t_window_h(nzb_wall,m)
7753       ENDIF
7754       IF ( ( humidity ) .AND. ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) )  THEN
7755                coef_green_1 = surf_usm_h%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                       &
7756                               * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb                 &
7757                               * t_surf_green_h(m)**4 + f_shf_green * surf_usm_h%pt1(m)            &
7758                               + f_qsws * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m) )              &
7759                               + lambda_surface_green * t_green_h(nzb_wall,m)
7760       ELSE
7761       coef_green_1 = surf_usm_h%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                &
7762                      * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb * t_surf_green_h(m)**4   &
7763                      + f_shf_green * surf_usm_h%pt1(m) + lambda_surface_green                     &
7764                      * t_green_h(nzb_wall,m)
7765       ENDIF
7766!
7767!--    Denominator of the prognostic equation
7768       coef_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_veg_wall) * sigma_sb * t_surf_wall_h(m)**3    &
7769                + lambda_surface + f_shf / exner(k)
7770       IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_h%frac(m,ind_wat_win) > 0.0_wp ) )  THEN
7771          coef_window_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_wat_win) * sigma_sb *               &
7772                          t_surf_window_h(m)**3 + lambda_surface_window + f_shf_window / exner(k)
7773       ENDIF
7774       IF ( ( humidity ) .AND. ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) )  THEN
7775          coef_green_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb *              &
7776                         t_surf_green_h(m)**3 + f_qsws * dq_s_dt + lambda_surface_green            &
7777                         + f_shf_green / exner(k)
7778       ELSE
7779       coef_green_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb                   &
7780                      * t_surf_green_h(m)**3 + lambda_surface_green + f_shf_green / exner(k)
7781       ENDIF
7782!
7783!--    Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
7784       t_surf_wall_h_p(m) = ( coef_1 * dt_3d * tsc(2) + surf_usm_h%c_surface(m)                    &
7785                              * t_surf_wall_h(m) )                                                 &
7786                            / ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) )
7787       IF ( ( .NOT. during_spinup ) .AND. (surf_usm_h%frac(m,ind_wat_win) > 0.0_wp) )  THEN
7788          t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) + surf_usm_h%c_surface_window(m) &
7789                                   * t_surf_window_h(m) ) /                                        &
7790                                 ( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
7791       ENDIF
7792       t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) + surf_usm_h%c_surface_green(m)       &
7793                               * t_surf_green_h(m) )                                               &
7794                             /  ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
7795!
7796!--    Add RK3 term
7797       t_surf_wall_h_p(m) = t_surf_wall_h_p(m) + dt_3d * tsc(3) *  surf_usm_h%tt_surface_wall_m(m)
7798
7799       t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) *                              &
7800                              surf_usm_h%tt_surface_window_m(m)
7801
7802       t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) * surf_usm_h%tt_surface_green_m(m)
7803!
7804!--    Store surface temperature on pt_surface. Further, in case humidity is used, store also
7805!--    vpt_surface, which is, due to the lack of moisture on roofs, simply assumed to be the surface
7806!--    temperature.
7807       surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(m,ind_veg_wall) * t_surf_wall_h_p(m)           &
7808                                    + surf_usm_h%frac(m,ind_wat_win) * t_surf_window_h_p(m)        &
7809                                    + surf_usm_h%frac(m,ind_pav_green) * t_surf_green_h_p(m)       &
7810                                  ) / exner(k)
7811
7812       IF ( humidity )  surf_usm_h%vpt_surface(m) = surf_usm_h%pt_surface(m)
7813!
7814!--    Calculate true tendency
7815       stend_wall = ( t_surf_wall_h_p(m) - t_surf_wall_h(m) - dt_3d * tsc(3) *                     &
7816                      surf_usm_h%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
7817       stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) *               &
7818                        surf_usm_h%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
7819       stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) *                  &
7820                       surf_usm_h%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
7821!
7822!--    Calculate t_surf tendencies for the next Runge-Kutta step
7823       IF ( timestep_scheme(1:5) == 'runge' )  THEN
7824          IF ( intermediate_timestep_count == 1 )  THEN
7825             surf_usm_h%tt_surface_wall_m(m)   = stend_wall
7826             surf_usm_h%tt_surface_window_m(m) = stend_window
7827             surf_usm_h%tt_surface_green_m(m)  = stend_green
7828          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
7829             surf_usm_h%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +                           &
7830                                               5.3125_wp * surf_usm_h%tt_surface_wall_m(m)
7831             surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window +                       &
7832                                                 5.3125_wp * surf_usm_h%tt_surface_window_m(m)
7833             surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green +                         &
7834                                                5.3125_wp * surf_usm_h%tt_surface_green_m(m)
7835          ENDIF
7836       ENDIF
7837!
7838!--    In case of fast changes in the skin temperature, it is required to update the radiative
7839!--    fluxes in order to keep the solution stable
7840       IF ( ( ( ABS( t_surf_wall_h_p(m)   - t_surf_wall_h(m) )   > 1.0_wp )   .OR.                 &
7841            (   ABS( t_surf_green_h_p(m)  - t_surf_green_h(m) )  > 1.0_wp )   .OR.                 &
7842            (   ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) )                      &
7843               .AND.  unscheduled_radiation_calls  )  THEN
7844          force_radiation_call_l = .TRUE.
7845       ENDIF
7846!
7847!--    Calculate fluxes
7848!--    Rad_net_l is never used!
7849       surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) + surf_usm_h%frac(m,ind_veg_wall)         &
7850                                 * sigma_sb * surf_usm_h%emissivity(m,ind_veg_wall)                &
7851                                 * ( t_surf_wall_h_p(m)**4 - t_surf_wall_h(m)**4 )                 &
7852                                 + surf_usm_h%frac(m,ind_wat_win) * sigma_sb                       &
7853                                 * surf_usm_h%emissivity(m,ind_wat_win)                            &
7854                                 * ( t_surf_window_h_p(m)**4 - t_surf_window_h(m)**4 )             &
7855                                 + surf_usm_h%frac(m,ind_pav_green) * sigma_sb                     &
7856                                 * surf_usm_h%emissivity(m,ind_pav_green)                          &
7857                                 * ( t_surf_green_h_p(m)**4 - t_surf_green_h(m)**4 )
7858
7859       surf_usm_h%wghf_eb(m)   = lambda_surface * ( t_surf_wall_h_p(m) - t_wall_h(nzb_wall,m) )
7860       surf_usm_h%wghf_eb_green(m)  = lambda_surface_green                                         &
7861                                      * ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
7862       surf_usm_h%wghf_eb_window(m) = lambda_surface_window                                        &
7863                                      * ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
7864
7865!
7866!--    Ground/wall/roof surface heat flux
7867       surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_wall_h_p(m) / exner(k) )  &
7868                                 * surf_usm_h%frac(m,ind_veg_wall) - f_shf_window                  &
7869                                 * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exner(k) )         &
7870                                 * surf_usm_h%frac(m,ind_wat_win) - f_shf_green                    &
7871                                 * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exner(k) )          &
7872                                 * surf_usm_h%frac(m,ind_pav_green)
7873!
7874!--    Store kinematic surface heat fluxes for utilization in other processes diffusion_s,
7875!--    surface_layer_fluxes,...
7876       surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p
7877!
7878!--    If the indoor model is applied, further add waste heat from buildings to the kinematic flux.
7879       IF ( indoor_model )  THEN
7880          surf_usm_h%shf(m) = surf_usm_h%shf(m) + surf_usm_h%waste_heat(m) / c_p
7881       ENDIF
7882
7883
7884       IF (surf_usm_h%frac(m,ind_pav_green) > 0.0_wp)  THEN
7885
7886
7887          IF ( humidity )  THEN
7888             surf_usm_h%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m) - dq_s_dt  &
7889                                                * t_surf_green_h_p(m) )
7890
7891             surf_usm_h%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m)   &
7892                                                         - dq_s_dt * t_surf_green_h_p(m) )
7893
7894             surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m)   &
7895                                                         - dq_s_dt * t_surf_green_h_p(m) )
7896
7897          ENDIF
7898
7899!
7900!--       Calculate the true surface resistance
7901          IF ( .NOT.  humidity )  THEN
7902             surf_usm_h%r_s(m) = 1.0E10_wp
7903          ELSE
7904             surf_usm_h%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt * t_surf_green_h(m) - dq_s_dt    &
7905                                 * t_surf_green_h_p(m) ) / (surf_usm_h%qsws(m) + 1.0E-20)          &
7906                                 - surf_usm_h%r_a_green(m)
7907          ENDIF
7908
7909!
7910!--       Calculate change in liquid water reservoir due to dew fall or evaporation of liquid water
7911          IF ( humidity )  THEN
7912!
7913!--          If precipitation is activated, add rain water to qsws_liq and qsws_soil according the
7914!--          the vegetation coverage.
7915!--          precipitation_rate is given in mm.
7916             IF ( precipitation )  THEN
7917
7918!
7919!--             Add precipitation to liquid water reservoir, if possible. Otherwise, add the water
7920!--             to soil. In case of pavements, the exceeding water amount is implicitely removed as
7921!--             runoff as qsws_soil is then not used in the soil model
7922                IF ( m_liq_usm_h%var_usm_1d(m) /= m_liq_max )  THEN
7923                   surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m)                                 &
7924                                            + surf_usm_h%frac(m,ind_pav_green)                     &
7925                                            * prr(k+k_off,j+j_off,i+i_off) * hyrho(k+k_off)        &
7926                                            * 0.001_wp * rho_l * l_v
7927               ENDIF
7928
7929             ENDIF
7930
7931!
7932!--          If the air is saturated, check the reservoir water level
7933             IF ( surf_usm_h%qsws(m) < 0.0_wp )  THEN
7934!
7935!--             Check if reservoir is full (avoid values > m_liq_max) In that case, qsws_liq goes to
7936!--             qsws_soil. In this case qsws_veg is zero anyway (because c_liq = 1), so that tend is
7937!--             zero and no further check is needed
7938                IF ( m_liq_usm_h%var_usm_1d(m) == m_liq_max )  THEN
7939!                  surf_usm_h%qsws_soil(m) = surf_usm_h%qsws_soil(m) + surf_usm_h%qsws_liq(m)
7940                   surf_usm_h%qsws_liq(m)  = 0.0_wp
7941                ENDIF
7942
7943!
7944!--             In case qsws_veg becomes negative (unphysical behavior), let the water enter the
7945!--             liquid water reservoir as dew on the plant
7946                IF ( surf_usm_h%qsws_veg(m) < 0.0_wp )  THEN
7947                   surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
7948                   surf_usm_h%qsws_veg(m) = 0.0_wp
7949                ENDIF
7950             ENDIF
7951
7952             surf_usm_h%qsws(m) = surf_usm_h%qsws(m) / l_v
7953
7954             tend = - surf_usm_h%qsws_liq(m) * drho_l_lv
7955             m_liq_usm_h_p%var_usm_1d(m) = m_liq_usm_h%var_usm_1d(m) + dt_3d *                     &
7956                                           ( tsc(2) * tend + tsc(3) * tm_liq_usm_h_m%var_usm_1d(m) )
7957!
7958!--         Check if reservoir is overfull -> reduce to maximum (conservation of water is violated
7959!--         here)
7960             m_liq_usm_h_p%var_usm_1d(m) = MIN( m_liq_usm_h_p%var_usm_1d(m), m_liq_max )
7961
7962!
7963!--         Check if reservoir is empty (avoid values < 0.0) (conservation of water is violated here)
7964             m_liq_usm_h_p%var_usm_1d(m) = MAX( m_liq_usm_h_p%var_usm_1d(m), 0.0_wp )
7965!
7966!--         Calculate m_liq tendencies for the next Runge-Kutta step
7967             IF ( timestep_scheme(1:5) == 'runge' )  THEN
7968                IF ( intermediate_timestep_count == 1 )  THEN
7969                   tm_liq_usm_h_m%var_usm_1d(m) = tend
7970                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
7971                   tm_liq_usm_h_m%var_usm_1d(m) = -9.5625_wp * tend +                              &
7972                                                  5.3125_wp * tm_liq_usm_h_m%var_usm_1d(m)
7973                ENDIF
7974             ENDIF
7975
7976          ENDIF
7977       ELSE
7978          surf_usm_h%r_s(m) = 1.0E10_wp
7979       ENDIF
7980!
7981!--    During spinup green and window fraction are set to zero. Here, the original values are
7982!--    restored.
7983       IF ( during_spinup )  THEN
7984          surf_usm_h%frac(m,ind_wat_win)   = frac_win
7985          surf_usm_h%frac(m,ind_veg_wall)  = frac_wall
7986          surf_usm_h%frac(m,ind_pav_green) = frac_green
7987       ENDIF
7988
7989    ENDDO
7990!
7991!-- Now, treat vertical surface elements
7992    !$OMP DO SCHEDULE (STATIC)
7993    DO  l = 0, 3
7994        DO  m = 1, surf_usm_v(l)%ns
7995!
7996!--        During spinup set green and window fraction to zero and restore at the end of the loop.
7997!--        Note, this is a temporary fix and needs to be removed later.
7998           IF ( during_spinup )  THEN
7999              frac_win   = surf_usm_v(l)%frac(m,ind_wat_win)
8000              frac_wall  = surf_usm_v(l)%frac(m,ind_veg_wall)
8001              frac_green = surf_usm_v(l)%frac(m,ind_pav_green)
8002              surf_usm_v(l)%frac(m,ind_wat_win)   = 0.0_wp
8003              surf_usm_v(l)%frac(m,ind_veg_wall)  = 1.0_wp
8004              surf_usm_v(l)%frac(m,ind_pav_green) = 0.0_wp
8005           ENDIF
8006!
8007!--        Get indices of respective grid point
8008           i = surf_usm_v(l)%i(m)
8009           j = surf_usm_v(l)%j(m)
8010           k = surf_usm_v(l)%k(m)
8011
8012!
8013!--        Please note, for vertical surfaces no Obukhov length is defined, since stratification
8014!--        is not considered in this case.
8015           lambda_surface        = surf_usm_v(l)%lambda_surf(m)
8016           lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
8017           lambda_surface_green  = surf_usm_v(l)%lambda_surf_green(m)
8018
8019!          pt1  = pt(k,j,i)
8020           IF ( humidity )  THEN
8021              qv1 = q(k,j,i)
8022           ELSE
8023              qv1 = 0.0_wp
8024           ENDIF
8025!
8026!--        Calculate rho * c_p coefficient at wall layer
8027           rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) )
8028
8029           IF (surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp )  THEN
8030!
8031!--           Calculate frequently used parameters
8032              rho_lv    = rho_cp / c_p * l_v
8033              drho_l_lv = 1.0_wp / (rho_l * l_v)
8034           ENDIF
8035
8036!--        Calculation of r_a for vertical surfaces
8037!--
8038!--        Heat transfer coefficient for forced convection along vertical walls follows formulation
8039!--        in TUF3d model (Krayenhoff & Voogt, 2006)
8040!--
8041!--        H = httc (Tsfc - Tair)
8042!--        httc = rw * (11.8 + 4.2 * Ueff) - 4.0
8043!--
8044!--             rw: Wall patch roughness relative to 1.0 for concrete
8045!--             Ueff: Effective wind speed
8046!--             - 4.0 is a reduction of Rowley et al (1930) formulation based on
8047!--             Cole and Sturrock (1977)
8048!--
8049!--             Ucan: Canyon wind speed
8050!--             wstar: Convective velocity
8051!--             Qs: Surface heat flux
8052!--             zH: Height of the convective layer
8053!--             wstar = (g/Tcan*Qs*zH)**(1./3.)
8054!--        Effective velocity components must always be defined at scalar grid point. The wall
8055!--        normal component is obtained by simple linear interpolation. (An alternative would be an
8056!--        logarithmic interpolation.) Parameter roughness_concrete (default value = 0.001) is used
8057!--        to calculation of roughness relative to concrete. Note, wind velocity is limited
8058!--        to avoid division by zero. The nominator can become <= 0.0 for values z0 < 3*10E-4.
8059           ueff        = MAX ( SQRT( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 +                   &
8060                                     ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 +                   &
8061                                     ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2 ),                  &
8062                               1.0_wp / 4.2_wp                                                     &
8063                               * ( 4.0_wp / ( surf_usm_v(l)%z0(m) * d_roughness_concrete )         &
8064                               - 11.8_wp ),                                                        &
8065                               0.1_wp                                                              &
8066                              )
8067
8068           surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) * d_roughness_concrete            &
8069                                  * ( 11.8_wp + 4.2_wp * ueff )  - 4.0_wp  )
8070!
8071!--        Limit aerodynamic resistance
8072           IF ( surf_usm_v(l)%r_a(m) < 1.0_wp )  surf_usm_v(l)%r_a(m) = 1.0_wp
8073
8074           f_shf         = rho_cp / surf_usm_v(l)%r_a(m)
8075           f_shf_window  = rho_cp / surf_usm_v(l)%r_a(m)
8076           f_shf_green   = rho_cp / surf_usm_v(l)%r_a(m)
8077
8078           IF ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) THEN
8079!
8080!--           Adapted from LSM:
8081!--           Second step: calculate canopy resistance r_canopy. f1-f3 here are defined as 1/f1-f3
8082!--           as in ECMWF documentation f1: correction for incoming shortwave radiation (stomata
8083!--           close at night)
8084              f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_v(l)%rad_sw_in(m) + 0.05_wp )                &
8085                                / (0.81_wp * (0.004_wp * surf_usm_v(l)%rad_sw_in(m) + 1.0_wp) ) )
8086!
8087!--           f2: Correction for soil moisture availability to plants (the integrated soil moisture
8088!--           must thus be considered here) f2 = 0 for very dry soils
8089              f2=1.0_wp
8090
8091!
8092!--           Calculate water vapour pressure at saturation
8093              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_v_p(l)%t(m) - 273.16_wp ) &
8094                                               / (  t_surf_green_v_p(l)%t(m) - 35.86_wp ) )
8095!
8096!--           f3: Correction for vapour pressure deficit
8097              IF ( surf_usm_v(l)%g_d(m) /= 0.0_wp )  THEN
8098!
8099!--              Calculate vapour pressure
8100                 e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
8101                 f3 = EXP ( - surf_usm_v(l)%g_d(m) * (e_s - e) )
8102              ELSE
8103                 f3 = 1.0_wp
8104              ENDIF
8105!
8106!--           Calculate canopy resistance. In case that c_veg is 0 (bare soils), this calculation is
8107!--           obsolete, as r_canopy is not used below.
8108!--           To do: check for very dry soil -> r_canopy goes to infinity
8109              surf_usm_v(l)%r_canopy(m) = surf_usm_v(l)%r_canopy_min(m) /                          &
8110                                          ( surf_usm_v(l)%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
8111
8112!
8113!--           Calculate saturation specific humidity
8114              q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8115!
8116!--           In case of dewfall, set evapotranspiration to zero. All super-saturated water is then
8117!--           removed from the air
8118              IF ( humidity  .AND.  q_s <= qv1 )  THEN
8119                 surf_usm_v(l)%r_canopy(m) = 0.0_wp
8120              ENDIF
8121
8122!
8123!--           Calculate coefficients for the total evapotranspiration
8124!--           In case of water surface, set vegetation and soil fluxes to zero.
8125!--           For pavements, only evaporation of liquid water is possible.
8126              f_qsws_veg  = rho_lv *                                                               &
8127                                ( 1.0_wp        - 0.0_wp ) / & !surf_usm_h%c_liq(m) ) /              &
8128                                ( surf_usm_v(l)%r_a(m) + surf_usm_v(l)%r_canopy(m) )
8129!             f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m) / surf_usm_h%r_a_green(m)
8130
8131              f_qsws = f_qsws_veg! + f_qsws_liq
8132!
8133!--           Calculate derivative of q_s for Taylor series expansion
8134              e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_v_p(l)%t(m) - 35.86_wp) - 17.269_wp      &
8135                               * ( t_surf_green_v_p(l)%t(m) - 273.16_wp)                           &
8136                               / ( t_surf_green_v_p(l)%t(m) - 35.86_wp)**2 )
8137
8138              dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
8139           ENDIF
8140
8141!
8142!--        Add LW up so that it can be removed in prognostic equation
8143           surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m) - surf_usm_v(l)%rad_sw_out(m)   &
8144                                        + surf_usm_v(l)%rad_lw_in(m)  - surf_usm_v(l)%rad_lw_out(m)
8145!
8146!--        Numerator of the prognostic equation
8147           coef_1 = surf_usm_v(l)%rad_net_l(m) +                             & ! Coef +1 corresponds to -lwout
8148                                                                               ! included in calculation of radnet_l
8149           ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_veg_wall) *                        &
8150                                   sigma_sb *  t_surf_wall_v(l)%t(m) ** 4 +                        &
8151                                   f_shf * surf_usm_v(l)%pt1(m) +                                  &
8152                                   lambda_surface * t_wall_v(l)%t(nzb_wall,m)
8153           IF ( ( .NOT. during_spinup )  .AND.  ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN
8154              coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                   & ! Coef +1 corresponds to -lwout
8155                                                                               ! included in calculation of radnet_l
8156             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_wat_win) *                       &
8157                                   sigma_sb * t_surf_window_v(l)%t(m) ** 4 +                       &
8158                                   f_shf * surf_usm_v(l)%pt1(m) +                                  &
8159                                   lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
8160           ENDIF
8161           IF ( ( humidity )  .AND.  ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) )  THEN
8162              coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                      & ! Coef +1 corresponds to -lwout
8163                                                                                 ! included in calculation of radnet_l
8164              ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb *         &
8165                                   t_surf_green_v(l)%t(m) ** 4 +                                   &
8166                                   f_shf * surf_usm_v(l)%pt1(m) + f_qsws * ( qv1 - q_s             &
8167                                   + dq_s_dt * t_surf_green_v(l)%t(m) ) +                          &
8168                                   lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8169           ELSE
8170             coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                       & ! Coef +1 corresponds to -lwout included
8171                                                                                 ! in calculation of radnet_l
8172             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb *          &
8173                                   t_surf_green_v(l)%t(m) ** 4 +                                   &
8174                                   f_shf * surf_usm_v(l)%pt1(m) +                                  &
8175                                   lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8176           ENDIF
8177
8178!
8179!--        Denominator of the prognostic equation
8180           coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_veg_wall) * sigma_sb                   &
8181                    * t_surf_wall_v(l)%t(m)**3 + lambda_surface + f_shf / exner(k)
8182           IF ( ( .NOT. during_spinup )  .AND.  ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN
8183              coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_wat_win) * sigma_sb          &
8184                              * t_surf_window_v(l)%t(m)**3 + lambda_surface_window + f_shf / exner(k)
8185           ENDIF
8186           IF ( ( humidity )  .AND.  ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) )  THEN
8187               coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb        &
8188                              * t_surf_green_v(l)%t(m)**3  + f_qsws * dq_s_dt                      &
8189                              + lambda_surface_green + f_shf / exner(k)
8190           ELSE
8191              coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb         &
8192                             * t_surf_green_v(l)%t(m)**3 + lambda_surface_green + f_shf / exner(k)
8193           ENDIF
8194!
8195!--        Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
8196           t_surf_wall_v_p(l)%t(m) = ( coef_1 * dt_3d * tsc(2) + surf_usm_v(l)%c_surface(m)        &
8197                                       * t_surf_wall_v(l)%t(m) ) / ( surf_usm_v(l)%c_surface(m)    &
8198                                       + coef_2 * dt_3d * tsc(2) )
8199           IF ( ( .NOT. during_spinup )  .AND.  ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN
8200              t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) +                       &
8201                                            surf_usm_v(l)%c_surface_window(m)                      &
8202                                            * t_surf_window_v(l)%t(m) ) /                          &
8203                                          ( surf_usm_v(l)%c_surface_window(m)                      &
8204                                            + coef_window_2 * dt_3d * tsc(2) )
8205           ENDIF
8206           t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) +                            &
8207                                        surf_usm_v(l)%c_surface_green(m)                           &
8208                                        * t_surf_green_v(l)%t(m) ) /                               &
8209                                      ( surf_usm_v(l)%c_surface_green(m)                           &
8210                                        + coef_green_2 * dt_3d * tsc(2) )
8211!
8212!--        Add RK3 term
8213           t_surf_wall_v_p(l)%t(m)   = t_surf_wall_v_p(l)%t(m) + dt_3d * tsc(3) *                  &
8214                                       surf_usm_v(l)%tt_surface_wall_m(m)
8215           t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) *                &
8216                                       surf_usm_v(l)%tt_surface_window_m(m)
8217           t_surf_green_v_p(l)%t(m)  = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) *                 &
8218                                       surf_usm_v(l)%tt_surface_green_m(m)
8219
8220!
8221!--        Store surface temperature. Further, in case humidity is used, store also vpt_surface,
8222!--        which is, due to the lack of moisture on roofs, simply assumed to be the surface temperature.
8223           surf_usm_v(l)%pt_surface(m) = ( surf_usm_v(l)%frac(m,ind_veg_wall)                      &
8224                                         * t_surf_wall_v_p(l)%t(m)                                 &
8225                                         + surf_usm_v(l)%frac(m,ind_wat_win)                       &
8226                                         * t_surf_window_v_p(l)%t(m)                               &
8227                                         + surf_usm_v(l)%frac(m,ind_pav_green)                     &
8228                                         * t_surf_green_v_p(l)%t(m) ) / exner(k)
8229
8230           IF ( humidity )  surf_usm_v(l)%vpt_surface(m) = surf_usm_v(l)%pt_surface(m)
8231!
8232!--        Calculate true tendency
8233           stend_wall = ( t_surf_wall_v_p(l)%t(m) - t_surf_wall_v(l)%t(m) - dt_3d * tsc(3) *       &
8234                          surf_usm_v(l)%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
8235           stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) * &
8236                            surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
8237           stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *    &
8238                           surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
8239
8240!
8241!--        Calculate t_surf_* tendencies for the next Runge-Kutta step
8242           IF ( timestep_scheme(1:5) == 'runge' )  THEN
8243              IF ( intermediate_timestep_count == 1 )  THEN
8244                 surf_usm_v(l)%tt_surface_wall_m(m)   = stend_wall
8245                 surf_usm_v(l)%tt_surface_window_m(m) = stend_window
8246                 surf_usm_v(l)%tt_surface_green_m(m)  = stend_green
8247              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
8248                 surf_usm_v(l)%tt_surface_wall_m(m)   = -9.5625_wp * stend_wall + 5.3125_wp        &
8249                                                         * surf_usm_v(l)%tt_surface_wall_m(m)
8250                 surf_usm_v(l)%tt_surface_green_m(m)  = -9.5625_wp * stend_green + 5.3125_wp       &
8251                                                        * surf_usm_v(l)%tt_surface_green_m(m)
8252                 surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window + 5.3125_wp      &
8253                                                        * surf_usm_v(l)%tt_surface_window_m(m)
8254              ENDIF
8255           ENDIF
8256
8257!
8258!--        In case of fast changes in the skin temperature, it is required to update the radiative
8259!--        fluxes in order to keep the solution stable
8260
8261           IF ( ( ( ABS( t_surf_wall_v_p(l)%t(m)   - t_surf_wall_v(l)%t(m) )   > 1.0_wp ) .OR.     &
8262                (   ABS( t_surf_green_v_p(l)%t(m)  - t_surf_green_v(l)%t(m) )  > 1.0_wp ) .OR.     &
8263                (   ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) )        &
8264                   .AND.  unscheduled_radiation_calls )  THEN
8265              force_radiation_call_l = .TRUE.
8266           ENDIF
8267
8268!
8269!--        Calculate fluxes
8270!--        Prognostic rad_net_l is used just for output!
8271           surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(m,ind_veg_wall) *                       &
8272                                        ( surf_usm_v(l)%rad_net_l(m) + 3.0_wp * sigma_sb *         &
8273                                        t_surf_wall_v(l)%t(m)**4 - 4.0_wp * sigma_sb *             &
8274                                        t_surf_wall_v(l)%t(m)**3 * t_surf_wall_v_p(l)%t(m) )       &
8275                                      + surf_usm_v(l)%frac(m,ind_wat_win) *                        &
8276                                        ( surf_usm_v(l)%rad_net_l(m) + 3.0_wp * sigma_sb *         &
8277                                        t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb *           &
8278                                        t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) )   &
8279                                      + surf_usm_v(l)%frac(m,ind_pav_green) *                      &
8280                                        ( surf_usm_v(l)%rad_net_l(m) + 3.0_wp * sigma_sb *         &
8281                                        t_surf_green_v(l)%t(m)**4 - 4.0_wp * sigma_sb *            &
8282                                        t_surf_green_v(l)%t(m)**3 * t_surf_green_v_p(l)%t(m) )
8283
8284           surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window *                               &
8285                                             ( t_surf_window_v_p(l)%t(m)                           &
8286                                               - t_window_v(l)%t(nzb_wall,m) )
8287           surf_usm_v(l)%wghf_eb(m) = lambda_surface * ( t_surf_wall_v_p(l)%t(m)                   &
8288                                                         - t_wall_v(l)%t(nzb_wall,m) )
8289           surf_usm_v(l)%wghf_eb_green(m) = lambda_surface_green *                                 &
8290                                            ( t_surf_green_v_p(l)%t(m)                             &
8291                                              - t_green_v(l)%t(nzb_wall,m) )
8292
8293!
8294!--        Ground/wall/roof surface heat flux
8295           surf_usm_v(l)%wshf_eb(m) = - f_shf  * ( surf_usm_v(l)%pt1(m) - t_surf_wall_v_p(l)%t(m)  &
8296                                      / exner(k) ) * surf_usm_v(l)%frac(m,ind_veg_wall)            &
8297                                     - f_shf_window  * ( surf_usm_v(l)%pt1(m)                      &
8298                                     - t_surf_window_v_p(l)%t(m) / exner(k) )                      &
8299                                     * surf_usm_v(l)%frac(m,ind_wat_win) - f_shf_green             &
8300                                     * ( surf_usm_v(l)%pt1(m) - t_surf_green_v_p(l)%t(m)           &
8301                                     / exner(k) ) * surf_usm_v(l)%frac(m,ind_pav_green)
8302
8303!
8304!--        Store kinematic surface heat fluxes for utilization in other processes diffusion_s,
8305!--        surface_layer_fluxes,...
8306           surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / c_p
8307!
8308!--        If the indoor model is applied, further add waste heat from buildings to the kinematic
8309!--        flux.
8310           IF ( indoor_model )  THEN
8311              surf_usm_v(l)%shf(m) = surf_usm_v(l)%shf(m) + surf_usm_v(l)%waste_heat(m) / c_p
8312           ENDIF
8313
8314           IF ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp )  THEN
8315
8316
8317              IF ( humidity )  THEN
8318                 surf_usm_v(l)%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt                         &
8319                                          * t_surf_green_v(l)%t(m) - dq_s_dt                       &
8320                                          * t_surf_green_v_p(l)%t(m) )
8321
8322                 surf_usm_v(l)%qsws(m) = surf_usm_v(l)%qsws(m) / l_v
8323
8324                 surf_usm_v(l)%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s + dq_s_dt                &
8325                                              * t_surf_green_v(l)%t(m) - dq_s_dt                   &
8326                                              * t_surf_green_v_p(l)%t(m) )
8327
8328!                 surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s + dq_s_dt                   &
8329!                                           * t_surf_green_h(m) - dq_s_dt                           &
8330!                                           * t_surf_green_h_p(m) )
8331              ENDIF
8332
8333!
8334!--           Calculate the true surface resistance
8335              IF ( .NOT.  humidity )  THEN
8336                 surf_usm_v(l)%r_s(m) = 1.0E10_wp
8337              ELSE
8338                 surf_usm_v(l)%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt * t_surf_green_v(l)%t(m)  &
8339                                        - dq_s_dt * t_surf_green_v_p(l)%t(m) ) /                   &
8340                                        (surf_usm_v(l)%qsws(m) + 1.0E-20)  - surf_usm_v(l)%r_a(m)
8341              ENDIF
8342
8343!
8344!--           Calculate change in liquid water reservoir due to dew fall or evaporation of liquid
8345!--           water
8346              IF ( humidity )  THEN
8347!
8348!--              If the air is saturated, check the reservoir water level
8349                 IF ( surf_usm_v(l)%qsws(m) < 0.0_wp )  THEN
8350
8351!
8352!--                 In case qsws_veg becomes negative (unphysical behavior), let the water enter the
8353!--                 liquid water reservoir as dew on the plant
8354                    IF ( surf_usm_v(l)%qsws_veg(m) < 0.0_wp )  THEN
8355       !                 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
8356                       surf_usm_v(l)%qsws_veg(m) = 0.0_wp
8357                    ENDIF
8358                 ENDIF
8359
8360              ENDIF
8361           ELSE
8362              surf_usm_v(l)%r_s(m) = 1.0E10_wp
8363           ENDIF
8364!
8365!--        During spinup green and window fraction are set to zero. Here, the original values are
8366!--        restored.
8367           IF ( during_spinup )  THEN
8368              surf_usm_v(l)%frac(m,ind_wat_win)   = frac_win
8369              surf_usm_v(l)%frac(m,ind_veg_wall)  = frac_wall
8370              surf_usm_v(l)%frac(m,ind_pav_green) = frac_green
8371           ENDIF
8372
8373        ENDDO
8374
8375    ENDDO
8376    !$OMP END PARALLEL
8377
8378!
8379!--  Add-up anthropogenic heat, for now only at upward-facing surfaces
8380      IF ( usm_anthropogenic_heat  .AND.    .NOT.  during_spinup   .AND.                           &
8381           intermediate_timestep_count == intermediate_timestep_count_max )  THEN
8382!
8383!--     Application of the additional anthropogenic heat sources. We considere the traffic for now,
8384!--     so all heat is absorbed to the first layer, generalization would be worth.
8385!--     Calculation of actual profile coefficient
8386!--     ??? check time_since_reference_point ???
8387         CALL get_date_time( time_since_reference_point, hour = dhour, second_of_day = dtime )
8388
8389!--      TO_DO: activate, if testcase is available
8390!--      !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
8391!--      It may also improve performance to move topo_top_ind before the k-loop
8392         DO i = nxl, nxr
8393            DO j = nys, nyn
8394               DO k = nz_urban_b, min(nz_urban_t,naheatlayers)
8395                  IF ( k > topo_top_ind(j,i,0) )  THEN
8396!
8397!--                 Increase of pt in box i,j,k in time dt_3d given to anthropogenic heat
8398!--                 aheat*acoef (W*m-2)
8399!--                 linear interpolation of coeficient
8400                     acoef = ( REAL( dhour+1,wp ) - dtime / seconds_per_hour )                     &
8401                             * aheatprof(k, dhour) +                                               &
8402                             ( dtime / seconds_per_hour - REAL( dhour, wp ) )                      &
8403                             * aheatprof(k,dhour+1)
8404                     IF ( aheat(k,j,i) > 0.0_wp )  THEN
8405!
8406!--                    Calculate rho * c_p coefficient at layer k
8407                        rho_cp  = c_p * hyp(k) / ( r_d * pt(k+1,j,i) * exner(k) )
8408                        pt(k,j,i) = pt(k,j,i) + aheat(k,j,i) * acoef * dt_3d / (exner(k) * rho_cp  &
8409                        * dz(1) )
8410                     ENDIF
8411                  ENDIF
8412               ENDDO
8413            ENDDO
8414         ENDDO
8415
8416      ENDIF
8417!
8418!--  pt and shf are defined on nxlg:nxrg,nysg:nyng .Get the borders from neighbours.
8419      CALL exchange_horiz( pt, nbgp )
8420!
8421!--  Calculation of force_radiation_call:
8422!--  Make logical OR for all processes.
8423!--  Force radiation call if at least one processor forces it.
8424      IF ( intermediate_timestep_count == intermediate_timestep_count_max-1 )  THEN
8425#if defined( __parallel )
8426        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
8427        CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,                          &
8428                            1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
8429#else
8430        force_radiation_call = force_radiation_call_l
8431#endif
8432        force_radiation_call_l = .FALSE.
8433      ENDIF
8434
8435! !
8436! !-- Calculate surface specific humidity
8437!  IF ( humidity )  THEN
8438!     CALL calc_q_surface_usm
8439!  ENDIF
8440
8441
8442! CONTAINS
8443! !------------------------------------------------------------------------------------------------!
8444! ! Description:
8445! ! ------------
8446! !> Calculation of specific humidity of the skin layer (surface). It is assumend that the skin is
8447! !> always saturated.
8448! !------------------------------------------------------------------------------------------------!
8449! SUBROUTINE calc_q_surface_usm
8450!
8451!    IMPLICIT NONE
8452!
8453!    REAL(wp)  ::  resistance  !< aerodynamic and soil resistance term
8454!
8455!    DO  m = 1, surf_usm_h%ns
8456!
8457!       i   = surf_usm_h%i(m)
8458!       j   = surf_usm_h%j(m)
8459!       k   = surf_usm_h%k(m)
8460!
8461!!
8462!!--   Calculate water vapour pressure at saturation
8463!       e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_h_p(m) - 273.16_wp ) /          &
8464!             ( t_surf_green_h_p(m) - 35.86_wp  ) )
8465!
8466!!
8467!!--   Calculate specific humidity at saturation
8468!       q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8469!
8470!!       surf_usm_h%r_a_green(m) = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /           &
8471!!                                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
8472!!
8473!! !-    Make sure that the resistance does not drop to zero
8474!!       IF ( ABS(surf_usm_h%r_a_green(m)) < 1.0E-10_wp )  surf_usm_h%r_a_green(m) = 1.0E-10_wp
8475!
8476!       resistance = surf_usm_h%r_a_green(m) / ( surf_usm_h%r_a_green(m) + surf_usm_h%r_s(m)        &
8477!                    + 1E-5_wp )
8478!
8479!!
8480!!--   Calculate specific humidity at surface
8481!       IF ( bulk_cloud_model )  THEN
8482!          q(k,j,i) = resistance * q_s + ( 1.0_wp - resistance ) * ( q(k,j,i) - ql(k,j,i) )
8483!       ELSE
8484!          q(k,j,i) = resistance * q_s + ( 1.0_wp - resistance ) * q(k,j,i)
8485!       ENDIF
8486!
8487!!
8488!!--   Update virtual potential temperature
8489!       vpt(k,j,i) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) )
8490!
8491!   ENDDO
8492!
8493!!
8494!!--Now, treat vertical surface elements
8495!    DO  l = 0, 3
8496!       DO  m = 1, surf_usm_v(l)%ns
8497!!
8498!!--      Get indices of respective grid point
8499!          i = surf_usm_v(l)%i(m)
8500!          j = surf_usm_v(l)%j(m)
8501!          k = surf_usm_v(l)%k(m)
8502!
8503!!
8504!!--      Calculate water vapour pressure at saturation
8505!          e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_v_p(l)%t(m) - 273.16_wp ) /  &
8506!                ( t_surf_green_v_p(l)%t(m) - 35.86_wp ) )
8507!
8508!!
8509!!--      Calculate specific humidity at saturation
8510!          q_s = 0.622_wp * e_s / ( surface_pressure -e_s )
8511!
8512!!
8513!!--      Calculate specific humidity at surface
8514!          IF ( bulk_cloud_model )  THEN
8515!             q(k,j,i) = ( q(k,j,i) - ql(k,j,i) )
8516!          ELSE
8517!             q(k,j,i) = q(k,j,i)
8518!          ENDIF
8519!!
8520!!--      Update virtual potential temperature
8521!          vpt(k,j,i) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) )
8522!
8523!       ENDDO
8524!
8525!    ENDDO
8526!
8527! END SUBROUTINE calc_q_surface_usm
8528
8529    IF ( debug_output_timestep )  THEN
8530       WRITE( debug_string, * ) 'usm_surface_energy_balance | during_spinup: ', during_spinup
8531       CALL debug_message( debug_string, 'end' )
8532    ENDIF
8533
8534 END SUBROUTINE usm_surface_energy_balance
8535
8536
8537!--------------------------------------------------------------------------------------------------!
8538! Description:
8539! ------------
8540!> Swapping of time levels for t_surf and t_wall called out from subroutine swap_timelevel
8541!--------------------------------------------------------------------------------------------------!
8542 SUBROUTINE usm_swap_timelevel( mod_count )
8543
8544    IMPLICIT NONE
8545
8546    INTEGER(iwp), INTENT(IN)  ::  mod_count  !<
8547
8548
8549    SELECT CASE ( mod_count )
8550
8551       CASE ( 0 )
8552!
8553!--      Horizontal surfaces
8554          t_surf_wall_h    => t_surf_wall_h_1;   t_surf_wall_h_p    => t_surf_wall_h_2
8555          t_wall_h         => t_wall_h_1;        t_wall_h_p         => t_wall_h_2
8556          t_surf_window_h  => t_surf_window_h_1; t_surf_window_h_p  => t_surf_window_h_2
8557          t_window_h       => t_window_h_1;      t_window_h_p       => t_window_h_2
8558          t_surf_green_h   => t_surf_green_h_1;  t_surf_green_h_p   => t_surf_green_h_2
8559          t_green_h        => t_green_h_1;       t_green_h_p        => t_green_h_2
8560!
8561!--      Vertical surfaces
8562          t_surf_wall_v    => t_surf_wall_v_1;   t_surf_wall_v_p    => t_surf_wall_v_2
8563          t_wall_v         => t_wall_v_1;        t_wall_v_p         => t_wall_v_2
8564          t_surf_window_v  => t_surf_window_v_1; t_surf_window_v_p  => t_surf_window_v_2
8565          t_window_v       => t_window_v_1;      t_window_v_p       => t_window_v_2
8566          t_surf_green_v   => t_surf_green_v_1;  t_surf_green_v_p   => t_surf_green_v_2
8567          t_green_v        => t_green_v_1;       t_green_v_p        => t_green_v_2
8568       CASE ( 1 )
8569!
8570!--      Horizontal surfaces
8571          t_surf_wall_h    => t_surf_wall_h_2;   t_surf_wall_h_p    => t_surf_wall_h_1
8572          t_wall_h         => t_wall_h_2;        t_wall_h_p         => t_wall_h_1
8573          t_surf_window_h  => t_surf_window_h_2; t_surf_window_h_p  => t_surf_window_h_1
8574          t_window_h       => t_window_h_2;      t_window_h_p       => t_window_h_1
8575          t_surf_green_h   => t_surf_green_h_2;  t_surf_green_h_p   => t_surf_green_h_1
8576          t_green_h        => t_green_h_2;       t_green_h_p        => t_green_h_1
8577!
8578!--      Vertical surfaces
8579          t_surf_wall_v    => t_surf_wall_v_2;   t_surf_wall_v_p    => t_surf_wall_v_1
8580          t_wall_v         => t_wall_v_2;        t_wall_v_p         => t_wall_v_1
8581          t_surf_window_v  => t_surf_window_v_2; t_surf_window_v_p  => t_surf_window_v_1
8582          t_window_v       => t_window_v_2;      t_window_v_p       => t_window_v_1
8583          t_surf_green_v   => t_surf_green_v_2;  t_surf_green_v_p   => t_surf_green_v_1
8584          t_green_v        => t_green_v_2;       t_green_v_p        => t_green_v_1
8585    END SELECT
8586
8587 END SUBROUTINE usm_swap_timelevel
8588
8589!--------------------------------------------------------------------------------------------------!
8590! Description:
8591! ------------
8592!> Subroutine writes t_surf and t_wall data into restart files
8593!--------------------------------------------------------------------------------------------------!
8594 SUBROUTINE usm_wrd_local
8595
8596
8597    IMPLICIT NONE
8598
8599    CHARACTER(LEN=1)  ::  dum  !< dummy string to create output-variable name
8600
8601    INTEGER(iwp)  ::  l  !< index surface type orientation
8602
8603    INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr)  ::  global_start_index  !< index for surface data (MPI-IO)
8604
8605    LOGICAL  ::  surface_data_to_write  !< switch for MPI-I/O if PE has surface data to write
8606
8607
8608    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
8609
8610       CALL wrd_write_string( 'ns_h_on_file_usm' )
8611       WRITE ( 14 )  surf_usm_h%ns
8612
8613       CALL wrd_write_string( 'ns_v_on_file_usm' )
8614       WRITE ( 14 )  surf_usm_v(0:3)%ns
8615
8616       CALL wrd_write_string( 'usm_start_index_h' )
8617       WRITE ( 14 )  surf_usm_h%start_index
8618
8619       CALL wrd_write_string( 'usm_end_index_h' )
8620       WRITE ( 14 )  surf_usm_h%end_index
8621
8622       CALL wrd_write_string( 't_surf_wall_h' )
8623       WRITE ( 14 )  t_surf_wall_h
8624
8625       CALL wrd_write_string( 't_surf_window_h' )
8626       WRITE ( 14 )  t_surf_window_h
8627
8628       CALL wrd_write_string( 't_surf_green_h' )
8629       WRITE ( 14 )  t_surf_green_h
8630
8631       CALL wrd_write_string( 'm_liq_usm_h' )
8632       WRITE ( 14 )  m_liq_usm_h%var_usm_1d
8633!
8634!--    Write restart data which is especially needed for the urban-surface model. In order to do not
8635!--    fill up the restart routines in surface_mod. Output of waste heat from indoor model. Restart
8636!--    data is required in this special case, because the indoor model, where waste heat is
8637!--    computed, is called each hour (current default), so that waste heat would have zero value
8638!--    until next call of indoor model.
8639       IF ( indoor_model )  THEN
8640          CALL wrd_write_string( 'waste_heat_h' )
8641          WRITE ( 14 )  surf_usm_h%waste_heat
8642       ENDIF
8643
8644       DO  l = 0, 3
8645
8646          CALL wrd_write_string( 'usm_start_index_v' )
8647          WRITE ( 14 )  surf_usm_v(l)%start_index
8648
8649          CALL wrd_write_string( 'usm_end_index_v' )
8650          WRITE ( 14 )  surf_usm_v(l)%end_index
8651
8652          WRITE( dum, '(I1)')  l
8653
8654          CALL wrd_write_string( 't_surf_wall_v(' // dum // ')' )
8655          WRITE ( 14 )  t_surf_wall_v(l)%t
8656
8657          CALL wrd_write_string( 't_surf_window_v(' // dum // ')' )
8658          WRITE ( 14 ) t_surf_window_v(l)%t
8659
8660          CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
8661          WRITE ( 14 ) t_surf_green_v(l)%t
8662
8663          IF ( indoor_model )  THEN
8664             CALL wrd_write_string( 'waste_heat_v(' // dum // ')' )
8665             WRITE ( 14 )  surf_usm_v(l)%waste_heat
8666          ENDIF
8667
8668       ENDDO
8669
8670       CALL wrd_write_string( 'usm_start_index_h' )
8671       WRITE ( 14 )  surf_usm_h%start_index
8672
8673       CALL wrd_write_string( 'usm_end_index_h' )
8674       WRITE ( 14 )  surf_usm_h%end_index
8675
8676       CALL wrd_write_string( 't_wall_h' )
8677       WRITE ( 14 )  t_wall_h
8678
8679       CALL wrd_write_string( 't_window_h' )
8680       WRITE ( 14 )  t_window_h
8681
8682       CALL wrd_write_string( 't_green_h' )
8683       WRITE ( 14 )  t_green_h
8684
8685       DO  l = 0, 3
8686
8687          CALL wrd_write_string( 'usm_start_index_v' )
8688          WRITE ( 14 )  surf_usm_v(l)%start_index
8689
8690          CALL wrd_write_string( 'usm_end_index_v' )
8691          WRITE ( 14 )  surf_usm_v(l)%end_index
8692
8693          WRITE( dum, '(I1)')  l
8694
8695          CALL wrd_write_string( 't_wall_v(' // dum // ')' )
8696          WRITE ( 14 )  t_wall_v(l)%t
8697
8698          CALL wrd_write_string( 't_window_v(' // dum // ')' )
8699          WRITE ( 14 )  t_window_v(l)%t
8700
8701          CALL wrd_write_string( 't_green_v(' // dum // ')' )
8702          WRITE ( 14 )  t_green_v(l)%t
8703
8704       ENDDO
8705
8706    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
8707!
8708!--    There is no information about the PE-grid necessary because the restart files consists of the
8709!--    whole domain. Therefore, ns_h_on_file_usm and ns_v_on_file_usm are not used with MPI-IO.
8710       CALL rd_mpi_io_surface_filetypes( surf_usm_h%start_index, surf_usm_h%end_index,             &
8711                                         surface_data_to_write, global_start_index )
8712
8713       CALL wrd_mpi_io( 'usm_start_index_h',  surf_usm_h%start_index )
8714       CALL wrd_mpi_io( 'usm_end_index_h', surf_usm_h%end_index )
8715       CALL wrd_mpi_io( 'usm_global_start_h', global_start_index )
8716
8717       CALL wrd_mpi_io_surface( 't_surf_wall_h',  t_surf_wall_h )
8718       CALL wrd_mpi_io_surface( 't_surf_window_h', t_surf_window_h )
8719       CALL wrd_mpi_io_surface( 't_surf_green_h', t_surf_green_h )
8720
8721       CALL wrd_mpi_io_surface( 'm_liq_usm_h', m_liq_usm_h%var_usm_1d )
8722       IF ( indoor_model )  THEN
8723          CALL wrd_mpi_io_surface( 'waste_heat_h', surf_usm_h%waste_heat ) ! NEED TO BE CHECKED!!!!!
8724       ENDIF
8725
8726       DO  l = 0, 3
8727
8728          WRITE( dum, '(I1)')  l
8729
8730          CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,    &
8731                                            surface_data_to_write, global_start_index )
8732
8733          CALL wrd_mpi_io( 'usm_start_index_v_' // dum, surf_usm_v(l)%start_index )
8734          CALL wrd_mpi_io( 'usm_end_index_v_' // dum, surf_usm_v(l)%end_index )
8735          CALL wrd_mpi_io( 'usm_global_start_v_' // dum, global_start_index )
8736
8737          IF ( .NOT. surface_data_to_write )  CYCLE
8738
8739          CALL wrd_mpi_io_surface( 't_surf_wall_v(' // dum // ')', t_surf_wall_v(l)%t )
8740          CALL wrd_mpi_io_surface( 't_surf_window_v(' // dum // ')', t_surf_window_v(l)%t )
8741          CALL wrd_mpi_io_surface( 't_surf_green_v(' // dum // ')', t_surf_green_v(l)%t )
8742
8743       ENDDO
8744
8745       CALL rd_mpi_io_surface_filetypes( surf_usm_h%start_index, surf_usm_h%end_index,             &
8746                                         surface_data_to_write, global_start_index )
8747
8748       CALL wrd_mpi_io( 'usm_start_index_h_2',  surf_usm_h%start_index )
8749       CALL wrd_mpi_io( 'usm_end_index_h_2', surf_usm_h%end_index )
8750       CALL wrd_mpi_io( 'usm_global_start_h_2', global_start_index )
8751
8752       CALL wrd_mpi_io_surface( 't_wall_h', t_wall_h )
8753       CALL wrd_mpi_io_surface( 't_window_h', t_window_h )
8754       CALL wrd_mpi_io_surface( 't_green_h', t_green_h )
8755
8756       DO  l = 0, 3
8757
8758          WRITE( dum, '(I1)')  l
8759
8760          CALL rd_mpi_io_surface_filetypes( surf_usm_v(l)%start_index, surf_usm_v(l)%end_index,    &
8761                                            surface_data_to_write, global_start_index )
8762
8763          CALL wrd_mpi_io( 'usm_start_index_v_2_' //dum, surf_usm_v(l)%start_index )
8764          CALL wrd_mpi_io( 'usm_end_index_v_2_' // dum, surf_usm_v(l)%end_index )
8765          CALL wrd_mpi_io( 'usm_global_start_v_2_' // dum, global_start_index )
8766
8767          IF ( .NOT. surface_data_to_write )  CYCLE
8768
8769          CALL wrd_mpi_io_surface( 't_wall_v(' // dum // ')', t_wall_v(l)%t )
8770          CALL wrd_mpi_io_surface( 't_window_v(' // dum // ')', t_window_v(l)%t )
8771          CALL wrd_mpi_io_surface( 't_green_v(' // dum // ')', t_green_v(l)%t )
8772
8773       ENDDO
8774
8775    ENDIF
8776
8777 END SUBROUTINE usm_wrd_local
8778
8779
8780!--------------------------------------------------------------------------------------------------!
8781! Description:
8782! ------------
8783!> Define building properties
8784!--------------------------------------------------------------------------------------------------!
8785 SUBROUTINE usm_define_pars
8786!
8787!-- Define the building_pars
8788    building_pars(:,1) = (/                                                                        &
8789       0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
8790       0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
8791       0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
8792       0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
8793       1.5_wp,         &  !< parameter 4   - LAI roof
8794       1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
8795       2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
8796       1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
8797       1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
8798       0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
8799       0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
8800       2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
8801       299.15_wp,      &  !< parameter 12  - indoor target summer temperature
8802       293.15_wp,      &  !< parameter 13  - indoor target winter temperature
8803       0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
8804       0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
8805       0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
8806       0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
8807       0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
8808       0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
8809       4.0_wp,         &  !< parameter 20  - ground floor level height
8810       0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
8811       0.25_wp,        &  !< parameter 22  - window fraction ground floor level
8812       0.0_wp,         &  !< parameter 23  - green fraction ground floor level
8813       0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
8814       1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
8815       2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
8816       1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
8817       1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
8818       0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
8819       0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
8820       2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
8821       0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
8822       0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
8823       0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
8824       0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
8825       0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
8826       0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
8827       27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
8828       5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
8829       27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
8830       0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
8831       0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
8832       0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
8833       0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
8834       20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
8835       23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
8836       20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
8837       20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
8838       23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
8839       10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
8840       1.0_wp,         &  !< parameter 51  - wall fraction ground plate
8841       0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
8842       0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
8843       0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
8844       0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
8845       2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
8846       1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
8847       1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
8848       0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
8849       0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
8850       2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
8851       0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
8852       0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
8853       0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
8854       0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
8855       27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
8856       0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
8857       0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
8858       0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
8859       0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
8860       1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
8861       1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
8862       1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
8863       0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
8864       0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
8865       0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
8866       27.0_wp,        &  !< parameter 77  - window albedo ground floor level
8867       5.0_wp,         &  !< parameter 78  - green albedo ground floor level
8868       0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
8869       0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
8870       0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
8871       0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
8872       1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
8873       1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
8874       1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
8875       0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
8876       0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
8877       0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
8878       1.0_wp,         &  !< parameter 89  - wall fraction roof
8879       0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
8880       0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
8881       0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
8882       0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
8883       2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
8884       1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
8885       1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
8886       0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
8887       0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
8888       2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
8889       0.93_wp,        &  !< parameter 100 - wall emissivity roof
8890       27.0_wp,        &  !< parameter 101 - wall albedo roof
8891       0.0_wp,         &  !< parameter 102 - window fraction roof
8892       0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
8893       0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
8894       0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
8895       0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
8896       1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
8897       1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
8898       1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
8899       0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
8900       0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
8901       0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
8902       0.91_wp,        &  !< parameter 113 - window emissivity roof
8903       0.75_wp,        &  !< parameter 114 - window transmissivity roof
8904       27.0_wp,        &  !< parameter 115 - window albedo roof
8905       0.86_wp,        &  !< parameter 116 - green emissivity roof
8906       5.0_wp,         &  !< parameter 117 - green albedo roof
8907       0.0_wp,         &  !< parameter 118 - green type roof
8908       0.8_wp,         &  !< parameter 119 - shading factor
8909       0.76_wp,        &  !< parameter 120 - g-value windows
8910       5.0_wp,         &  !< parameter 121 - u-value windows
8911       0.5_wp,         &  !< parameter 122 - basic airflow without occupancy of the room for - summer 0.5_wp, winter 0.1
8912       2.0_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 2.0_wp, winter 0.5
8913       0.0_wp,         &  !< parameter 124 - heat recovery efficiency
8914       3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
8915       370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heat storage
8916       4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
8917       100.0_wp,       &  !< parameter 128 - maximal heating capacity
8918       0.0_wp,         &  !< parameter 129 - maximal cooling capacity
8919       2.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
8920       6.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
8921       3.0_wp,         &  !< parameter 132 - storey height
8922       0.2_wp,         &  !< parameter 133 - ceiling construction height
8923       0.1_wp,         &  !< parameter 134 - anthropogenic heat output for heating
8924       1.333_wp        &  !< parameter 135 - anthropogenic heat output for cooling
8925                        /)
8926
8927    building_pars(:,2) = (/                                                                        &
8928          0.73_wp,        &  !< parameter 0   - wall fraction above ground floor level
8929          0.27_wp,        &  !< parameter 1   - window fraction above ground floor level
8930          0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
8931          0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
8932          1.5_wp,         &  !< parameter 4   - LAI roof
8933          1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
8934          2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
8935          103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
8936          900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
8937          0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
8938          0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
8939          0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
8940          299.15_wp,      &  !< parameter 12  - indoor target summer temperature
8941          293.15_wp,      &  !< parameter 13  - indoor target winter temperature
8942          0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
8943          0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
8944          0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
8945          0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
8946          0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
8947          0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
8948          4.0_wp,         &  !< parameter 20  - ground floor level height
8949          0.78_wp,        &  !< parameter 21  - wall fraction ground floor level
8950          0.22_wp,        &  !< parameter 22  - window fraction ground floor level
8951          0.0_wp,         &  !< parameter 23  - green fraction ground floor level
8952          0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
8953          1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
8954          2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
8955          103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
8956          900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
8957          0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
8958          0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
8959          0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
8960          0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
8961          0.11_wp,        &  !< parameter 33  - window emissivity ground floor level
8962          0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
8963          0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
8964          0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
8965          0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
8966          27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
8967          5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
8968          27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
8969          0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
8970          0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
8971          0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
8972          0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
8973          20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
8974          23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
8975          20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
8976          20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
8977          23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
8978          10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
8979          1.0_wp,         &  !< parameter 51  - wall fraction ground plate
8980          0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
8981          0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
8982          0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
8983          0.42_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
8984          2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
8985          103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
8986          900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
8987          0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
8988          0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
8989          0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
8990          0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
8991          0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
8992          0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
8993          0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
8994          27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
8995          0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
8996          0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
8997          0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
8998          0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
8999          1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9000          1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9001          1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9002          0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9003          0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9004          0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9005          27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9006          5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9007          0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9008          0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9009          0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9010          0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9011          1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9012          1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9013          1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9014          0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9015          0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9016          0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9017          1.0_wp,         &  !< parameter 89  - wall fraction roof
9018          0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9019          0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9020          0.5_wp,         &  !< parameter 92  - 3rd wall layer thickness roof
9021          0.79_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9022          2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9023          103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9024          900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9025          0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9026          0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9027          0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9028          0.93_wp,        &  !< parameter 100 - wall emissivity roof
9029          27.0_wp,        &  !< parameter 101 - wall albedo roof
9030          0.0_wp,         &  !< parameter 102 - window fraction roof
9031          0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9032          0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9033          0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9034          0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9035          1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9036          1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9037          1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9038          0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9039          0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9040          0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9041          0.87_wp,        &  !< parameter 113 - window emissivity roof
9042          0.7_wp,         &  !< parameter 114 - window transmissivity roof
9043          27.0_wp,        &  !< parameter 115 - window albedo roof
9044          0.86_wp,        &  !< parameter 116 - green emissivity roof
9045          5.0_wp,         &  !< parameter 117 - green albedo roof
9046          0.0_wp,         &  !< parameter 118 - green type roof
9047          0.8_wp,         &  !< parameter 119 - shading factor
9048          0.6_wp,         &  !< parameter 120 - g-value windows
9049          3.0_wp,         &  !< parameter 121 - u-value windows
9050          0.5_wp,         &  !< parameter 122 - basic airflow without occupancy of the room for - summer 0.5_wp for winter 0.1
9051          2.0_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 2.0_wp
9052                             !< for winter 0.5
9053          0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9054          2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9055          165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9056          4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9057          100.0_wp,       &  !< parameter 128 - maximal heating capacity
9058          0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9059          2.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9060          6.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9061          3.0_wp,         &  !< parameter 132 - storey height
9062          0.2_wp,         &  !< parameter 133 - ceiling construction height
9063          0.1_wp,         &  !< parameter 134 - anthropogenic heat output for heating
9064          1.333_wp        &  !< parameter 135 - anthropogenic heat output for cooling
9065                           /)
9066
9067    building_pars(:,3) = (/                                                                        &
9068             0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
9069             0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
9070             0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9071             0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9072             1.5_wp,         &  !< parameter 4   - LAI roof
9073             1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9074             2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9075             103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9076             900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9077             0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9078             0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9079             0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9080             299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9081             293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9082             0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9083             0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9084             0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9085             0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9086             0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9087             0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9088             3.0_wp,         &  !< parameter 20  - ground floor level height
9089             0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
9090             0.25_wp,        &  !< parameter 22  - window fraction ground floor level
9091             0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9092             0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9093             1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9094             2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9095             103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9096             900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9097             0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9098             0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9099             0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9100             0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9101             0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9102             0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9103             0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9104             0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9105             0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9106             27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9107             5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9108             27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9109             0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9110             0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9111             0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9112             0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9113             20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9114             23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9115             20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9116             20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9117             23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9118             10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9119             1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9120             0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9121             0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9122             0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9123             0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9124             2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9125             103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9126             900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9127             0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9128             0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9129             0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9130             0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9131             0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9132             0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9133             0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9134             27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9135             0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9136             0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9137             0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9138             0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9139             1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9140             1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9141             1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9142             0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9143             0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9144             0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9145             27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9146             5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9147             0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9148             0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9149             0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9150             0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9151             1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9152             1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9153             1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9154             0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9155             0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9156             0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9157             1.0_wp,         &  !< parameter 89  - wall fraction roof
9158             0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9159             0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9160             0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9161             0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9162             2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9163             103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9164             900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9165             0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9166             0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9167             0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9168             0.93_wp,        &  !< parameter 100 - wall emissivity roof
9169             27.0_wp,        &  !< parameter 101 - wall albedo roof
9170             0.0_wp,         &  !< parameter 102 - window fraction roof
9171             0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9172             0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9173             0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9174             0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9175             1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9176             1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9177             1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9178             0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9179             0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9180             0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9181             0.8_wp,         &  !< parameter 113 - window emissivity roof
9182             0.6_wp,         &  !< parameter 114 - window transmissivity roof
9183             27.0_wp,        &  !< parameter 115 - window albedo roof
9184             0.86_wp,        &  !< parameter 116 - green emissivity roof
9185             5.0_wp,         &  !< parameter 117 - green albedo roof
9186             0.0_wp,         &  !< parameter 118 - green type roof
9187             0.3_wp,         &  !< parameter 119 - shading factor
9188             0.5_wp,         &  !< parameter 120 - g-value windows
9189             1.0_wp,         &  !< parameter 121 - u-value windows
9190             0.8_wp,         &  !< parameter 122 - basical airflow without occupancy of the room for - summer 0.8_wp, winter 0.1
9191             2.0_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 2.0_wp,
9192                                !< winter 0.5
9193             0.8_wp,         &  !< parameter 124 - heat recovery efficiency
9194             2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9195             80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9196             4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9197             100.0_wp,       &  !< parameter 128 - maximal heating capacity
9198             0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9199             2.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9200             6.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9201             3.0_wp,         &  !< parameter 132 - storey height
9202             0.2_wp,         &  !< parameter 133 - ceiling construction height
9203             -2.0_wp,        &  !< parameter 134 - anthropogenic heat output for heating
9204             1.25_wp         &  !< parameter 135 - anthropogenic heat output for cooling
9205                              /)
9206
9207    building_pars(:,4) = (/                                                                        &
9208      0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9209      0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9210      0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9211      0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9212      1.5_wp,         &  !< parameter 4   - LAI roof
9213      1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9214      2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9215      1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9216      1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9217      0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9218      0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9219      2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9220      299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9221      293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9222      0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9223      0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9224      0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
9225      0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
9226      0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9227      0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9228      4.0_wp,         &  !< parameter 20  - ground floor level height
9229      0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9230      0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9231      0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9232      0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9233      1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9234      2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9235      1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9236      1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9237      0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9238      0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9239      2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9240      0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
9241      0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
9242      0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9243      0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
9244      0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9245      0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9246      27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9247      5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9248      27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9249      0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9250      0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9251      0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9252      0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9253      20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9254      23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9255      20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9256      20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9257      23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9258      10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9259      1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9260      0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9261      0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9262      0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9263      0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9264      2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9265      1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9266      1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9267      0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9268      0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9269      2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9270      0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9271      0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9272      0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9273      0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9274      27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9275      0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9276      0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9277      0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9278      0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9279      1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9280      1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9281      1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9282      0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9283      0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9284      0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9285      27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9286      5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9287      0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9288      0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9289      0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9290      0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9291      1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9292      1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9293      1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9294      0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9295      0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9296      0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9297      1.0_wp,         &  !< parameter 89  - wall fraction roof
9298      0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9299      0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9300      0.39_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9301      0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9302      2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9303      1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9304      1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9305      0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9306      0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9307      2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9308      0.93_wp,        &  !< parameter 100 - wall emissivity roof
9309      27.0_wp,        &  !< parameter 101 - wall albedo roof
9310      0.0_wp,         &  !< parameter 102 - window fraction roof
9311      0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9312      0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9313      0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9314      0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9315      1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9316      1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9317      1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9318      0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9319      0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9320      0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9321      0.91_wp,        &  !< parameter 113 - window emissivity roof
9322      0.75_wp,        &  !< parameter 114 - window transmissivity roof
9323      27.0_wp,        &  !< parameter 115 - window albedo roof
9324      0.86_wp,        &  !< parameter 116 - green emissivity roof
9325      5.0_wp,         &  !< parameter 117 - green albedo roof
9326      0.0_wp,         &  !< parameter 118 - green type roof
9327      0.25_wp,        &  !< parameter 119 - shading factor
9328      0.76_wp,        &  !< parameter 120 - g-value windows
9329      5.0_wp,         &  !< parameter 121 - u-value windows
9330      0.1_wp,         &  !< parameter 122 - basic airflow without occupancy of the room for - summer 0.1_wp, winter 0.1
9331      1.5_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 1.5
9332      0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9333      3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9334      370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9335      4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9336      100.0_wp,       &  !< parameter 128 - maximal heating capacity
9337      -200.0_wp,      &  !< parameter 129 - maximal cooling capacity
9338      3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9339      10.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9340      3.0_wp,         &  !< parameter 132 - storey height
9341      0.2_wp,         &  !< parameter 133 - ceiling construction height
9342      0.1_wp,         &  !< parameter 134 - anthropogenic heat output for heating
9343      1.333_wp        &  !< parameter 135 - anthropogenic heat output for cooling
9344                       /)
9345
9346    building_pars(:,5) = (/                                                                        &
9347      0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9348      0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9349      0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9350      0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9351      1.5_wp,         &  !< parameter 4   - LAI roof
9352      1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9353      2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9354      103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9355      900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9356      0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9357      0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9358      0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9359      299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9360      293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9361      0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9362      0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9363      0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
9364      0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9365      0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9366      0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9367      4.0_wp,         &  !< parameter 20  - ground floor level height
9368      0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9369      0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9370      0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9371      0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9372      1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9373      2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9374      103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9375      900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9376      0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9377      0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9378      0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9379      0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9380      0.87_wp,        &  !< parameter 33  - window emissivity ground floor level
9381      0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9382      0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
9383      0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9384      0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9385      27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9386      5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9387      27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9388      0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9389      0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9390      0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9391      0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9392      20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9393      23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9394      20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9395      20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9396      23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9397      10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9398      1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9399      0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9400      0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9401      0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9402      0.43_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9403      2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9404      103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9405      900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9406      0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9407      0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9408      0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9409      0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9410      0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9411      0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9412      0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9413      27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9414      0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9415      0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9416      0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9417      0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9418      1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9419      1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9420      1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9421      0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9422      0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9423      0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9424      27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9425      5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9426      0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9427      0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9428      0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9429      0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9430      1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9431      1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9432      1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9433      0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9434      0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9435      0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9436      1.0_wp,         &  !< parameter 89  - wall fraction roof
9437      0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9438      0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9439      0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9440      0.43_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9441      2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9442      103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9443      900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9444      0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9445      0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9446      0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9447      0.91_wp,        &  !< parameter 100 - wall emissivity roof
9448      27.0_wp,        &  !< parameter 101 - wall albedo roof
9449      0.0_wp,         &  !< parameter 102 - window fraction roof
9450      0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9451      0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9452      0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9453      0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9454      1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9455      1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9456      1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9457      0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9458      0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9459      0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9460      0.87_wp,        &  !< parameter 113 - window emissivity roof
9461      0.7_wp,         &  !< parameter 114 - window transmissivity roof
9462      27.0_wp,        &  !< parameter 115 - window albedo roof
9463      0.86_wp,        &  !< parameter 116 - green emissivity roof
9464      5.0_wp,         &  !< parameter 117 - green albedo roof
9465      0.0_wp,         &  !< parameter 118 - green type roof
9466      0.25_wp,        &  !< parameter 119 - shading factor
9467      0.6_wp,         &  !< parameter 120 - g-value windows
9468      3.0_wp,         &  !< parameter 121 - u-value windows
9469      0.1_wp,         &  !< parameter 122 - basic airflow without occupancy of the room for - summer 0.1_wp, winter 0.1
9470      1.5_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 1.5
9471      0.65_wp,        &  !< parameter 124 - heat recovery efficiency
9472      2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9473      165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9474      4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9475      100.0_wp,       &  !< parameter 128 - maximal heating capacity
9476      -200.0_wp,      &  !< parameter 129 - maximal cooling capacity
9477      7.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9478      20.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9479      3.0_wp,         &  !< parameter 132 - storey height
9480      0.2_wp,         &  !< parameter 133 - ceiling construction height
9481      0.0_wp,         &  !< parameter 134 - anthropogenic heat output for heating
9482      2.54_wp         &  !< parameter 135 - anthropogenic heat output for cooling
9483                       /)
9484
9485    building_pars(:,6) = (/                                                                        &
9486      0.425_wp,       &  !< parameter 0   - wall fraction above ground floor level
9487      0.575_wp,       &  !< parameter 1   - window fraction above ground floor level
9488      0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9489      0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9490      1.5_wp,         &  !< parameter 4   - LAI roof
9491      1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9492      2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9493      103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9494      900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9495      0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9496      0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9497      0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9498      299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9499      293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9500      0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9501      0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9502      0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9503      0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9504      0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9505      0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9506      4.0_wp,         &  !< parameter 20  - ground floor level height
9507      0.475_wp,       &  !< parameter 21  - wall fraction ground floor level
9508      0.525_wp,       &  !< parameter 22  - window fraction ground floor level
9509      0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9510      0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9511      1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9512      2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9513      103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9514      900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9515      0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9516      0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9517      0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9518      0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9519      0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9520      0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9521      0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9522      0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9523      0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9524      27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9525      5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9526      27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9527      0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9528      0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9529      0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9530      0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9531      20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9532      23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9533      20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9534      20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9535      23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9536      10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9537      1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9538      0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9539      0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9540      0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9541      0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9542      2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9543      103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9544      900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9545      0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9546      0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9547      0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9548      0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9549      0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9550      0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9551      0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9552      27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9553      0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9554      0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9555      0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9556      0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9557      1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9558      1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9559      1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9560      0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9561      0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9562      0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9563      27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9564      5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9565      0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9566      0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9567      0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9568      0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9569      1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9570      1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9571      1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9572      0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9573      0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9574      0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9575      1.0_wp,         &  !< parameter 89  - wall fraction roof
9576      0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9577      0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9578      0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9579      0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9580      2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9581      103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9582      900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9583      0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9584      0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9585      0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9586      0.91_wp,        &  !< parameter 100 - wall emissivity roof
9587      27.0_wp,        &  !< parameter 101 - wall albedo roof
9588      0.0_wp,         &  !< parameter 102 - window fraction roof
9589      0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9590      0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9591      0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9592      0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9593      1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9594      1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9595      1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9596      0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9597      0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9598      0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9599      0.8_wp,         &  !< parameter 113 - window emissivity roof
9600      0.6_wp,         &  !< parameter 114 - window transmissivity roof
9601      27.0_wp,        &  !< parameter 115 - window albedo roof
9602      0.86_wp,        &  !< parameter 116 - green emissivity roof
9603      5.0_wp,         &  !< parameter 117 - green albedo roof
9604      0.0_wp,         &  !< parameter 118 - green type roof
9605      0.25_wp,        &  !< parameter 119 - shading factor
9606      0.5_wp,         &  !< parameter 120 - g-value windows
9607      2.5_wp,         &  !< parameter 121 - u-value windows
9608      0.1_wp,         &  !< parameter 122 - basic airflow without occupancy of the room for - summer 0.1_wp, winter 0.1
9609      1.5_wp,         &  !< parameter 123 - additional airflow dependent on occupancy of the room for - summer 1.5_wp, winter 1.5
9610      0.9_wp,         &  !< parameter 124 - heat recovery efficiency
9611      2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9612      80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9613      4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9614      100.0_wp,       &  !< parameter 128 - maximal heating capacity
9615      -80.0_wp,       &  !< parameter 129 - maximal cooling capacity
9616      5.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9617      15.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9618      3.0_wp,         &  !< parameter 132 - storey height
9619      0.2_wp,         &  !< parameter 133 - ceiling construction height
9620      -2.0_wp,        &  !< parameter 134 - anthropogenic heat output for heating
9621      1.25_wp         &  !< parameter 135 - anthropogenic heat output for cooling
9622                       /)
9623
9624    building_pars(:,7) = (/                                                                        &
9625      1.0_wp,         &  !< parameter 0   - wall fraction above ground floor level
9626      0.0_wp,         &  !< parameter 1   - window fraction above ground floor level
9627      0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9628      0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9629      1.5_wp,         &  !< parameter 4   - LAI roof
9630      1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9631      1950400.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9632      1848000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9633      1848000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9634      0.7_wp,         &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9635      1.0_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9636      1.0_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9637      299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9638      293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9639      0.9_wp,         &  !< parameter 14  - wall emissivity above ground floor level
9640      0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9641      0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9642      0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9643      0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9644      0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9645      4.0_wp,         &  !< parameter 20  - ground floor level height
9646      1.0_wp,         &  !< parameter 21  - wall fraction ground floor level
9647      0.0_wp,         &  !< parameter 22  - window fraction ground floor level
9648      0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9649      0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9650      1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9651      1950400.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9652      1848000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9653      1848000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9654      0.7_wp,         &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9655      1.0_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9656      1.0_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9657      0.9_wp,         &  !< parameter 32  - wall emissivity ground floor level
9658      0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9659      0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9660      0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9661      0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9662      0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9663      27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9664      5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9665      27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9666      0.29_wp,        &  !< parameter 41  - 1st wall layer thickness above ground floor level
9667      0.295_wp,       &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9668      0.695_wp,       &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9669      0.985_wp,       &  !< parameter 44  - 4th wall layer thickness above ground floor level
9670      20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9671      23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9672      20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9673      20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9674      23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9675      10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9676      1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9677      0.29_wp,        &  !< parameter 52  - 1st wall layer thickness ground plate
9678      0.295_wp,       &  !< parameter 53  - 2nd wall layer thickness ground plate
9679      0.695_wp,       &  !< parameter 54  - 3rd wall layer thickness ground plate
9680      0.985_wp,       &  !< parameter 55  - 4th wall layer thickness ground plate
9681      1950400.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9682      1848000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9683      1848000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9684      0.7_wp,         &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9685      1.0_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9686      1.0_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9687      0.29_wp,        &  !< parameter 62  - 1st wall layer thickness ground floor level
9688      0.295_wp,       &  !< parameter 63  - 2nd wall layer thickness ground floor level
9689      0.695_wp,       &  !< parameter 64  - 3rd wall layer thickness ground floor level
9690      0.985_wp,       &  !< parameter 65  - 4th wall layer thickness ground floor level
9691      27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9692      0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9693      0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9694      0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9695      0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9696      1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9697      1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9698      1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9699      0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9700      0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9701      0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9702      27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9703      5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9704      0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9705      0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9706      0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9707      0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9708      1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9709      1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9710      1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9711      0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9712      0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9713      0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9714      1.0_wp,         &  !< parameter 89  - wall fraction roof
9715      0.29_wp,        &  !< parameter 90  - 1st wall layer thickness roof
9716      0.295_wp,       &  !< parameter 91  - 2nd wall layer thickness roof
9717      0.695_wp,       &  !< parameter 92  - 3rd wall layer thickness roof
9718      0.985_wp,       &  !< parameter 93  - 4th wall layer thickness roof
9719      1950400.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9720      1848000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9721      1848000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9722      0.7_wp,         &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9723      1.0_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9724      1.0_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9725      0.9_wp,         &  !< parameter 100 - wall emissivity roof
9726      27.0_wp,        &  !< parameter 101 - wall albedo roof
9727      0.0_wp,         &  !< parameter 102 - window fraction roof
9728      0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9729      0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9730      0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9731      0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9732      1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9733      1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9734      1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9735      0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9736      0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9737      0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9738      0.8_wp,         &  !< parameter 113 - window emissivity roof
9739      0.6_wp,         &  !< parameter 114 - window transmissivity roof
9740      27.0_wp,        &  !< parameter 115 - window albedo roof
9741      0.86_wp,        &  !< parameter 116 - green emissivity roof
9742      5.0_wp,         &  !< parameter 117 - green albedo roof
9743      0.0_wp,         &  !< parameter 118 - green type roof
9744      0.8_wp,         &  !< parameter 119 - shading factor
9745      100.0_wp,       &  !< parameter 120 - g-value windows
9746      100.0_wp,       &  !< parameter 121 - u-value windows
9747      20.0_wp,        &  !< parameter 122 - basic airflow without occupancy of the room
9748      20.0_wp,        &  !< parameter 123 - additional airflow dependent on occupancy of the room
9749      0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9750      1.0_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9751      1.0_wp,         &  !< parameter 126 - dynamic parameter innner heatstorage
9752      4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9753      100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9754      0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9755      0.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9756      0.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9757      3.0_wp,         &  !< parameter 132 - storey height
9758      0.2_wp,         &  !< parameter 133 - ceiling construction height
9759      0.0_wp,         &  !< parameter 134 - anthropogenic heat output for heating
9760      0.0_wp          &  !< parameter 135 - anthropogenic heat output for cooling
9761                   /)
9762
9763 END SUBROUTINE usm_define_pars
9764
9765
9766 END MODULE urban_surface_mod
Note: See TracBrowser for help on using the repository browser.