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

Last change on this file since 4124 was 4077, checked in by gronemeier, 5 years ago

Set roughness length z0 and z0h/q at ground-floor level to same value as those above ground-floor level (urban_surface_mod.f90)

  • Property svn:keywords set to Id
File size: 557.6 KB
Line 
1!> @file urban_surface_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2015-2019 Czech Technical University in Prague
18! Copyright 2015-2019 Institute of Computer Science of the
19!                     Czech Academy of Sciences, Prague
20! Copyright 1997-2019 Leibniz Universitaet Hannover
21!------------------------------------------------------------------------------!
22!
23! Current revisions:
24! ------------------
25!
26!
27! Former revisions:
28! -----------------
29! $Id: urban_surface_mod.f90 4077 2019-07-09 13:27:11Z gronemeier $
30! Set roughness length z0 and z0h/q at ground-floor level to same value as
31! those above ground-floor level
32!
33! 4051 2019-06-24 13:58:30Z suehring
34! Remove work-around for green surface fraction on buildings
35! (do not set it zero)
36!
37! 4050 2019-06-24 13:57:27Z suehring
38! In order to avoid confusion with global control parameter, rename the
39! USM-internal flag spinup into during_spinup.
40!
41! 3987 2019-05-22 09:52:13Z kanani
42! Introduce alternative switch for debug output during timestepping
43!
44! 3943 2019-05-02 09:50:41Z maronga
45! Removed qsws_eb. Bugfix in calculation of qsws.
46!
47! 3933 2019-04-25 12:33:20Z kanani
48! Remove allocation of pt_2m, this is done in surface_mod now (surfaces%pt_2m)
49!
50! 3921 2019-04-18 14:21:10Z suehring
51! Undo accidentally commented initialization 
52!
53! 3918 2019-04-18 13:33:11Z suehring
54! Set green fraction to zero also at vertical surfaces
55!
56! 3914 2019-04-17 16:02:02Z suehring
57! In order to obtain correct surface temperature during spinup set window
58! fraction to zero (only during spinup) instead of just disabling
59! time-integration of window-surface temperature.
60!
61! 3901 2019-04-16 16:17:02Z suehring
62! Workaround - set green fraction to zero ( green-heat model crashes ).
63!
64! 3896 2019-04-15 10:10:17Z suehring
65!
66!
67! 3896 2019-04-15 10:10:17Z suehring
68! Bugfix, wrong index used for accessing building_pars from PIDS
69!
70! 3885 2019-04-11 11:29:34Z kanani
71! Changes related to global restructuring of location messages and introduction
72! of additional debug messages
73!
74! 3882 2019-04-10 11:08:06Z suehring
75! Avoid different type kinds
76! Move definition of building-surface properties from declaration block
77! to an extra routine
78!
79! 3881 2019-04-10 09:31:22Z suehring
80! Revise determination of local ground-floor level height.
81! Make level 3 initalization conform with Palm-input-data standard
82! Move output of albedo and emissivity to radiation module
83!
84! 3832 2019-03-28 13:16:58Z raasch
85! instrumented with openmp directives
86!
87! 3824 2019-03-27 15:56:16Z pavelkrc
88! Remove unused imports
89!
90!
91! 3814 2019-03-26 08:40:31Z pavelkrc
92! unused subroutine commented out
93!
94! 3769 2019-02-28 10:16:49Z moh.hefny
95! removed unused variables
96!
97! 3767 2019-02-27 08:18:02Z raasch
98! unused variables removed from rrd-subroutines parameter list
99!
100! 3748 2019-02-18 10:38:31Z suehring
101! Revise conversion of waste-heat flux (do not divide by air density, will
102! be done in diffusion_s)
103!
104! 3745 2019-02-15 18:57:56Z suehring
105! - Remove internal flag indoor_model (is a global control parameter)
106! - add waste heat from buildings to the kinmatic heat flux
107! - consider waste heat in restart data
108! - remove unused USE statements
109!
110! 3744 2019-02-15 18:38:58Z suehring
111! fixed surface heat capacity in the building parameters
112! convert the file back to unix format
113!
114! 3730 2019-02-11 11:26:47Z moh.hefny
115! Formatting and clean-up (rvtils)
116!
117! 3710 2019-01-30 18:11:19Z suehring
118! Check if building type is set within a valid range.
119!
120! 3705 2019-01-29 19:56:39Z suehring
121! make nzb_wall public, required for virtual-measurements
122!
123! 3704 2019-01-29 19:51:41Z suehring
124! Some interface calls moved to module_interface + cleanup
125!
126! 3655 2019-01-07 16:51:22Z knoop
127! Implementation of the PALM module interface
128!
129! 3636 2018-12-19 13:48:34Z raasch
130! nopointer option removed
131!
132! 3614 2018-12-10 07:05:46Z raasch
133! unused variables removed
134!
135! 3607 2018-12-07 11:56:58Z suehring
136! Output of radiation-related quantities migrated to radiation_model_mod.
137!
138! 3597 2018-12-04 08:40:18Z maronga
139! Fixed calculation method of near surface air potential temperature at 10 cm
140! and moved to surface_layer_fluxes. Removed unnecessary _eb strings.
141!
142! 3524 2018-11-14 13:36:44Z raasch
143! bugfix concerning allocation of t_surf_wall_v
144!
145! 3502 2018-11-07 14:45:23Z suehring
146! Disable initialization of building roofs with ground-floor-level properties,
147! since this causes strong oscillations of surface temperature during the
148! spinup.
149!
150! 3469 2018-10-30 20:05:07Z kanani
151! Add missing PUBLIC variables for new indoor model
152!
153! 3449 2018-10-29 19:36:56Z suehring
154! Bugfix: Fix average arrays allocations in usm_3d_data_averaging (J.Resler)
155! Bugfix: Fix reading wall temperatures (J.Resler)
156! Bugfix: Fix treating of outputs for wall temperature and sky view factors (J.Resler)
157!
158!
159! 3435 2018-10-26 18:25:44Z gronemeier
160! Bugfix: allocate gamma_w_green_sat until nzt_wall+1
161!
162! 3418 2018-10-24 16:07:39Z kanani
163! (rvtils, srissman)
164! -Updated building databse, two green roof types (ind_green_type_roof)
165! -Latent heat flux for green walls and roofs, new output of latent heatflux
166!  and soil water content of green roof substrate
167! -t_surf changed to t_surf_wall
168! -Added namelist parameter usm_wall_mod for lower wall tendency
169!  of first two wall layers during spinup
170! -Window calculations deactivated during spinup
171!
172! 3382 2018-10-19 13:10:32Z knoop
173! Bugix: made array declaration Fortran Standard conform
174!
175! 3378 2018-10-19 12:34:59Z kanani
176! merge from radiation branch (r3362) into trunk
177! (moh.hefny):
178! - check the requested output variables if they are correct
179! - added unscheduled_radiation_calls switch to control force_radiation_call
180! - minor formate changes
181!
182! 3371 2018-10-18 13:40:12Z knoop
183! Set flag indicating that albedo at urban surfaces is already initialized
184!
185! 3347 2018-10-15 14:21:08Z suehring
186! Enable USM initialization with default building parameters in case no static
187! input file exist.
188!
189! 3343 2018-10-15 10:38:52Z suehring
190! Add output variables usm_rad_pc_inlw, usm_rad_pc_insw*
191!
192! 3274 2018-09-24 15:42:55Z knoop
193! Modularization of all bulk cloud physics code components
194!
195! 3248 2018-09-14 09:42:06Z sward
196! Minor formating changes
197!
198! 3246 2018-09-13 15:14:50Z sward
199! Added error handling for input namelist via parin_fail_message
200!
201! 3241 2018-09-12 15:02:00Z raasch
202! unused variables removed
203!
204! 3223 2018-08-30 13:48:17Z suehring
205! Bugfix for commit 3222
206!
207! 3222 2018-08-30 13:35:35Z suehring
208! Introduction of surface array for type and its name
209!
210! 3203 2018-08-23 10:48:36Z suehring
211! Revise bulk parameter for emissivity at ground-floor level
212!
213! 3196 2018-08-13 12:26:14Z maronga
214! Added maximum aerodynamic resistance of 300 for horiztonal surfaces.
215!
216! 3176 2018-07-26 17:12:48Z suehring
217! Bugfix, update virtual potential surface temparture, else heat fluxes on
218! roofs might become unphysical
219!
220! 3152 2018-07-19 13:26:52Z suehring
221! Initialize q_surface, which might be used in surface_layer_fluxes
222!
223! 3151 2018-07-19 08:45:38Z raasch
224! remaining preprocessor define strings __check removed
225!
226! 3136 2018-07-16 14:48:21Z suehring
227! Limit also roughness length for heat and moisture where necessary
228!
229! 3123 2018-07-12 16:21:53Z suehring
230! Correct working precision for INTEGER number
231!
232! 3115 2018-07-10 12:49:26Z suehring
233! Additional building type to represent bridges
234!
235! 3091 2018-06-28 16:20:35Z suehring
236! - Limit aerodynamic resistance at vertical walls.
237! - Add check for local roughness length not exceeding surface-layer height and
238!   limit roughness length where necessary.
239!
240! 3065 2018-06-12 07:03:02Z Giersch
241! Unused array dxdir was removed, dz was replaced by dzu to consider vertical
242! grid stretching
243!
244! 3049 2018-05-29 13:52:36Z Giersch
245! Error messages revised
246!
247! 3045 2018-05-28 07:55:41Z Giersch
248! Error message added
249!
250! 3029 2018-05-23 12:19:17Z raasch
251! bugfix: close unit 151 instead of 90
252!
253! 3014 2018-05-09 08:42:38Z maronga
254! Added pc_transpiration_rate
255!
256! 2977 2018-04-17 10:27:57Z kanani
257! Implement changes from branch radiation (r2948-2971) with minor modifications.
258! (moh.hefny):
259! Extended exn for all model domain height to avoid the need to get nzut.
260!
261! 2963 2018-04-12 14:47:44Z suehring
262! Introduce index for vegetation/wall, pavement/green-wall and water/window
263! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
264!
265! 2943 2018-04-03 16:17:10Z suehring
266! Calculate exner function at all height levels and remove some un-used
267! variables.
268!
269! 2932 2018-03-26 09:39:22Z maronga
270! renamed urban_surface_par to urban_surface_parameters
271!
272! 2921 2018-03-22 15:05:23Z Giersch
273! The activation of spinup has been moved to parin
274!
275! 2920 2018-03-22 11:22:01Z kanani
276! Remove unused pcbl, npcbl from ONLY list
277! moh.hefny:
278! Fixed bugs introduced by new structures and by moving radiation interaction
279! into radiation_model_mod.f90.
280! Bugfix: usm data output 3D didn't respect directions
281!
282! 2906 2018-03-19 08:56:40Z Giersch
283! Local variable ids has to be initialized with a value of -1 in
284! usm_3d_data_averaging
285!
286! 2894 2018-03-15 09:17:58Z Giersch
287! Calculations of the index range of the subdomain on file which overlaps with
288! the current subdomain are already done in read_restart_data_mod,
289! usm_read/write_restart_data have been renamed to usm_r/wrd_local, variable
290! named found has been introduced for checking if restart data was found,
291! reading of restart strings has been moved completely to
292! read_restart_data_mod, usm_rrd_local is already inside the overlap loop
293! programmed in read_restart_data_mod, SAVE attribute added where necessary,
294! deallocation and allocation of some arrays have been changed to take care of
295! different restart files that can be opened (index i), the marker *** end usm
296! *** is not necessary anymore, strings and their respective lengths are
297! written out and read now in case of restart runs to get rid of prescribed
298! character lengths
299!
300! 2805 2018-02-14 17:00:09Z suehring
301! Initialization of resistances.
302!
303! 2797 2018-02-08 13:24:35Z suehring
304! Comment concerning output of ground-heat flux added.
305!
306! 2766 2018-01-22 17:17:47Z kanani
307! Removed redundant commas, added some blanks
308!
309! 2765 2018-01-22 11:34:58Z maronga
310! Major bugfix in calculation of f_shf. Adjustment of roughness lengths in
311! building_pars
312!
313! 2750 2018-01-15 16:26:51Z knoop
314! Move flag plant canopy to modules
315!
316! 2737 2018-01-11 14:58:11Z kanani
317! Removed unused variables t_surf_whole...
318!
319! 2735 2018-01-11 12:01:27Z suehring
320! resistances are saved in surface attributes
321!
322! 2723 2018-01-05 09:27:03Z maronga
323! Bugfix for spinups (end_time was increased twice in case of LSM + USM runs)
324!
325! 2720 2018-01-02 16:27:15Z kanani
326! Correction of comment
327!
328! 2718 2018-01-02 08:49:38Z maronga
329! Corrected "Former revisions" section
330!
331! 2705 2017-12-18 11:26:23Z maronga
332! Changes from last commit documented
333!
334! 2703 2017-12-15 20:12:38Z maronga
335! Workaround for calculation of r_a
336!
337! 2696 2017-12-14 17:12:51Z kanani
338! - Change in file header (GPL part)
339! - Bugfix in calculation of pt_surface and related fluxes. (BM)
340! - Do not write surface temperatures onto pt array as this might cause
341!   problems with nesting. (MS)
342! - Revised calculation of pt1 (now done in surface_layer_fluxes).
343!   Bugfix, f_shf_window and f_shf_green were not set at vertical surface
344!   elements. (MS)
345! - merged with branch ebsolver
346!   green building surfaces do not evaporate yet
347!   properties of green wall layers and window layers are taken from wall layers
348!   this input data is missing. (RvT)
349! - Merged with branch radiation (developed by Mohamed Salim)
350! - Revised initialization. (MS)
351! - Rename emiss_surf into emissivity, roughness_wall into z0, albedo_surf into
352!   albedo. (MS)
353! - Move first call of usm_radiatin from usm_init to init_3d_model
354! - fixed problem with near surface temperature
355! - added near surface temperature pt_10cm_h(m), pt_10cm_v(l)%t(m)
356! - does not work with temp profile including stability, ol
357!   pt_10cm = pt1 now
358! - merged with 2357 bugfix, error message for nopointer version
359! - added indoor model coupling with wall heat flux
360! - added green substrate/ dry vegetation layer for buildings
361! - merged with 2232 new surface-type structure
362! - added transmissivity of window tiles
363! - added MOSAIK tile approach for 3 different surfaces (RvT)
364!
365! 2583 2017-10-26 13:58:38Z knoop
366! Bugfix: reverted MPI_Win_allocate_cptr introduction in last commit
367!
368! 2582 2017-10-26 13:19:46Z hellstea
369! Workaround for gnufortran compiler added in usm_calc_svf. CALL MPI_Win_allocate is
370! replaced by CALL MPI_Win_allocate_cptr if defined ( __gnufortran ).
371!
372! 2544 2017-10-13 18:09:32Z maronga
373! Date and time quantities are now read from date_and_time_mod. Solar constant is
374! read from radiation_model_mod
375!
376! 2516 2017-10-04 11:03:04Z suehring
377! Remove tabs
378!
379! 2514 2017-10-04 09:52:37Z suehring
380! upper bounds of 3d output changed from nx+1,ny+1 to nx,ny
381! no output of ghost layer data
382!
383! 2350 2017-08-15 11:48:26Z kanani
384! Bugfix and error message for nopointer version.
385! Additional "! defined(__nopointer)" as workaround to enable compilation of
386! nopointer version.
387!
388! 2318 2017-07-20 17:27:44Z suehring
389! Get topography top index via Function call
390!
391! 2317 2017-07-20 17:27:19Z suehring
392! Bugfix: adjust output of shf. Added support for spinups
393!
394! 2287 2017-06-15 16:46:30Z suehring
395! Bugfix in determination topography-top index
396!
397! 2269 2017-06-09 11:57:32Z suehring
398! Enable restart runs with different number of PEs
399! Bugfixes nopointer branch
400!
401! 2258 2017-06-08 07:55:13Z suehring
402! Bugfix, add pre-preprocessor directives to enable non-parrallel mode
403!
404! 2233 2017-05-30 18:08:54Z suehring
405!
406! 2232 2017-05-30 17:47:52Z suehring
407! Adjustments according to new surface-type structure. Remove usm_wall_heat_flux;
408! insteat, heat fluxes are directly applied in diffusion_s.
409!
410! 2213 2017-04-24 15:10:35Z kanani
411! Removal of output quantities usm_lad and usm_canopy_hr
412!
413! 2209 2017-04-19 09:34:46Z kanani
414! cpp switch __mpi3 removed,
415! minor formatting,
416! small bugfix for division by zero (Krc)
417!
418! 2113 2017-01-12 13:40:46Z kanani
419! cpp switch __mpi3 added for MPI-3 standard code (Ketelsen)
420!
421! 2071 2016-11-17 11:22:14Z maronga
422! Small bugfix (Resler)
423!
424! 2031 2016-10-21 15:11:58Z knoop
425! renamed variable rho to rho_ocean
426!
427! 2024 2016-10-12 16:42:37Z kanani
428! Bugfixes in deallocation of array plantt and reading of csf/csfsurf,
429! optimization of MPI-RMA operations,
430! declaration of pcbl as integer,
431! renamed usm_radnet -> usm_rad_net, usm_canopy_khf -> usm_canopy_hr,
432! splitted arrays svf -> svf & csf, svfsurf -> svfsurf & csfsurf,
433! use of new control parameter varnamelength,
434! added output variables usm_rad_ressw, usm_rad_reslw,
435! minor formatting changes,
436! minor optimizations.
437!
438! 2011 2016-09-19 17:29:57Z kanani
439! Major reformatting according to PALM coding standard (comments, blanks,
440! alphabetical ordering, etc.),
441! removed debug_prints,
442! removed auxiliary SUBROUTINE get_usm_info, instead, USM flag urban_surface is
443! defined in MODULE control_parameters (modules.f90) to avoid circular
444! dependencies,
445! renamed canopy_heat_flux to pc_heating_rate, as meaning of quantity changed.
446!
447! 2007 2016-08-24 15:47:17Z kanani
448! Initial revision
449!
450!
451! Description:
452! ------------
453! 2016/6/9 - Initial version of the USM (Urban Surface Model)
454!            authors: Jaroslav Resler, Pavel Krc
455!                     (Czech Technical University in Prague and Institute of
456!                      Computer Science of the Czech Academy of Sciences, Prague)
457!            with contributions: Michal Belda, Nina Benesova, Ondrej Vlcek
458!            partly inspired by PALM LSM (B. Maronga)
459!            parameterizations of Ra checked with TUF3D (E. S. Krayenhoff)
460!> Module for Urban Surface Model (USM)
461!> The module includes:
462!>    1. radiation model with direct/diffuse radiation, shading, reflections
463!>       and integration with plant canopy
464!>    2. wall and wall surface model
465!>    3. surface layer energy balance
466!>    4. anthropogenic heat (only from transportation so far)
467!>    5. necessary auxiliary subroutines (reading inputs, writing outputs,
468!>       restart simulations, ...)
469!> It also make use of standard radiation and integrates it into
470!> urban surface model.
471!>
472!> Further work:
473!> -------------
474!> 1. Remove global arrays surfouts, surfoutl and only keep track of radiosity
475!>    from surfaces that are visible from local surfaces (i.e. there is a SVF
476!>    where target is local). To do that, radiosity will be exchanged after each
477!>    reflection step using MPI_Alltoall instead of current MPI_Allgather.
478!>
479!> 2. Temporarily large values of surface heat flux can be observed, up to
480!>    1.2 Km/s, which seem to be not realistic.
481!>
482!> @todo Output of _av variables in case of restarts
483!> @todo Revise flux conversion in energy-balance solver
484!> @todo Check optimizations for RMA operations
485!> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi)
486!> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
487!>       factor 3 between min and max time
488!> @todo Check divisions in wtend (etc.) calculations for possible division
489!>       by zero, e.g. in case fraq(0,m) + fraq(1,m) = 0?!
490!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
491!> @todo Move plant canopy stuff into plant canopy code
492!------------------------------------------------------------------------------!
493 MODULE urban_surface_mod
494
495    USE arrays_3d,                                                             &
496        ONLY:  hyp, zu, pt, p, u, v, w, tend, exner, hyrho, prr, q, ql, vpt
497
498    USE calc_mean_profile_mod,                                                 &
499        ONLY:  calc_mean_profile
500
501    USE basic_constants_and_equations_mod,                                     &
502        ONLY:  c_p, g, kappa, pi, r_d, rho_l, l_v, sigma_sb
503
504    USE control_parameters,                                                    &
505        ONLY:  coupling_start_time, topography,                                &
506               debug_output, debug_output_timestep, debug_string,              &
507               dt_3d, humidity, indoor_model,                                  &
508               intermediate_timestep_count, initializing_actions,              &
509               intermediate_timestep_count_max, simulated_time, end_time,      &
510               timestep_scheme, tsc, coupling_char, io_blocks, io_group,       &
511               message_string, time_since_reference_point, surface_pressure,   &
512               pt_surface, large_scale_forcing, lsf_surf,                      &
513               spinup_pt_mean, spinup_time, time_do3d, dt_do3d,                &
514               average_count_3d, varnamelength, urban_surface, dz
515
516    USE bulk_cloud_model_mod,                                                  &
517        ONLY: bulk_cloud_model, precipitation
518               
519    USE cpulog,                                                                &
520        ONLY:  cpu_log, log_point, log_point_s
521
522    USE date_and_time_mod,                                                     &
523        ONLY:  time_utc_init
524
525    USE grid_variables,                                                        &
526        ONLY:  dx, dy, ddx, ddy, ddx2, ddy2
527
528    USE indices,                                                               &
529        ONLY:  nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys,    &
530               nysg, nzb, nzt, nbgp, wall_flags_0
531
532    USE, INTRINSIC :: iso_c_binding 
533
534    USE kinds
535             
536    USE pegrid
537       
538    USE radiation_model_mod,                                                   &
539        ONLY:  albedo_type, radiation_interaction,                             &
540               radiation, rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,        &
541               force_radiation_call, iup_u, inorth_u, isouth_u, ieast_u,       &
542               iwest_u, iup_l, inorth_l, isouth_l, ieast_l, iwest_l, id,       &
543               iz, iy, ix,  nsurf, idsvf, ndsvf,                               &
544               idcsf, ndcsf, kdcsf, pct,                                       &
545               nz_urban_b, nz_urban_t, unscheduled_radiation_calls
546
547    USE statistics,                                                            &
548        ONLY:  hom, statistic_regions
549
550    USE surface_mod,                                                           &
551        ONLY:  get_topography_top_index_ji, get_topography_top_index,          &
552               ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h,           &
553               surf_usm_v, surface_restore_elements
554
555
556    IMPLICIT NONE
557
558!
559!-- USM model constants
560
561    REAL(wp), PARAMETER ::                     &
562              b_ch               = 6.04_wp,    &  !< Clapp & Hornberger exponent
563              lambda_h_green_dry = 0.19_wp,    &  !< heat conductivity for dry soil   
564              lambda_h_green_sm  = 3.44_wp,    &  !< heat conductivity of the soil matrix
565              lambda_h_water     = 0.57_wp,    &  !< heat conductivity of water
566              psi_sat            = -0.388_wp,  &  !< soil matrix potential at saturation
567              rho_c_soil         = 2.19E6_wp,  &  !< volumetric heat capacity of soil
568              rho_c_water        = 4.20E6_wp      !< volumetric heat capacity of water
569!               m_max_depth        = 0.0002_wp     ! Maximum capacity of the water reservoir (m)
570
571!
572!-- Soil parameters I           alpha_vg,      l_vg_green,    n_vg, gamma_w_green_sat
573    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: soil_pars = RESHAPE( (/     &
574                                 3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, &  !< soil 1
575                                 3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, &  !< soil 2
576                                 0.83_wp, -0.588_wp, 1.25_wp,  0.26E-6_wp, &  !< soil 3
577                                 3.67_wp, -1.977_wp, 1.10_wp,  2.87E-6_wp, &  !< soil 4
578                                 2.65_wp,  2.500_wp, 1.10_wp,  1.74E-6_wp, &  !< soil 5
579                                 1.30_wp,  0.400_wp, 1.20_wp,  0.93E-6_wp, &  !< soil 6
580                                 0.00_wp,  0.00_wp,  0.00_wp,  0.57E-6_wp  &  !< soil 7
581                                 /), (/ 4, 7 /) )
582
583!
584!-- Soil parameters II              swc_sat,     fc,   wilt,    swc_res 
585    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: m_soil_pars = RESHAPE( (/ &
586                                 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp, &  !< soil 1
587                                 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp, &  !< soil 2
588                                 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp, &  !< soil 3
589                                 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp, &  !< soil 4
590                                 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp, &  !< soil 5
591                                 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp, &  !< soil 6
592                                 0.472_wp, 0.323_wp, 0.171_wp, 0.000_wp  &  !< soil 7
593                                 /), (/ 4, 7 /) )
594!
595!-- value 9999999.9_wp -> generic available or user-defined value must be set
596!-- otherwise -> no generic variable and user setting is optional
597    REAL(wp) :: alpha_vangenuchten = 9999999.9_wp,      &  !< NAMELIST alpha_vg
598                field_capacity = 9999999.9_wp,          &  !< NAMELIST fc
599                hydraulic_conductivity = 9999999.9_wp,  &  !< NAMELIST gamma_w_green_sat
600                l_vangenuchten = 9999999.9_wp,          &  !< NAMELIST l_vg
601                n_vangenuchten = 9999999.9_wp,          &  !< NAMELIST n_vg
602                residual_moisture = 9999999.9_wp,       &  !< NAMELIST m_res
603                saturation_moisture = 9999999.9_wp,     &  !< NAMELIST m_sat
604                wilting_point = 9999999.9_wp               !< NAMELIST m_wilt
605   
606!
607!-- configuration parameters (they can be setup in PALM config)
608    LOGICAL ::  usm_material_model = .TRUE.        !< flag parameter indicating wheather the  model of heat in materials is used
609    LOGICAL ::  usm_anthropogenic_heat = .FALSE.   !< flag parameter indicating wheather the anthropogenic heat sources
610                                                   !< (e.g.transportation) are used
611    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
612    LOGICAL ::  read_wall_temp_3d = .FALSE.
613    LOGICAL ::  usm_wall_mod = .FALSE.             !< reduces conductivity of the first 2 wall layers by factor 0.1
614
615
616    INTEGER(iwp) ::  building_type = 1               !< default building type (preleminary setting)
617    INTEGER(iwp) ::  land_category = 2               !< default category for land surface
618    INTEGER(iwp) ::  wall_category = 2               !< default category for wall surface over pedestrian zone
619    INTEGER(iwp) ::  pedestrian_category = 2         !< default category for wall surface in pedestrian zone
620    INTEGER(iwp) ::  roof_category = 2               !< default category for root surface
621    REAL(wp)     ::  roughness_concrete = 0.001_wp   !< roughness length of average concrete surface
622!
623!-- Indices of input attributes in building_pars for (above) ground floor level
624    INTEGER(iwp) ::  ind_alb_wall_agfl     = 38   !< index in input list for albedo_type of wall above ground floor level
625    INTEGER(iwp) ::  ind_alb_wall_gfl      = 66   !< index in input list for albedo_type of wall ground floor level
626    INTEGER(iwp) ::  ind_alb_wall_r        = 101  !< index in input list for albedo_type of wall roof
627    INTEGER(iwp) ::  ind_alb_green_agfl    = 39   !< index in input list for albedo_type of green above ground floor level
628    INTEGER(iwp) ::  ind_alb_green_gfl     = 78   !< index in input list for albedo_type of green ground floor level
629    INTEGER(iwp) ::  ind_alb_green_r       = 117  !< index in input list for albedo_type of green roof
630    INTEGER(iwp) ::  ind_alb_win_agfl      = 40   !< index in input list for albedo_type of window fraction above ground floor level
631    INTEGER(iwp) ::  ind_alb_win_gfl       = 77   !< index in input list for albedo_type of window fraction ground floor level
632    INTEGER(iwp) ::  ind_alb_win_r         = 115  !< index in input list for albedo_type of window fraction roof
633    INTEGER(iwp) ::  ind_c_surface         = 45   !< index in input list for heat capacity wall surface
634    INTEGER(iwp) ::  ind_c_surface_green   = 48   !< index in input list for heat capacity green surface
635    INTEGER(iwp) ::  ind_c_surface_win     = 47   !< index in input list for heat capacity window surface
636    INTEGER(iwp) ::  ind_emis_wall_agfl    = 14   !< index in input list for wall emissivity, above ground floor level
637    INTEGER(iwp) ::  ind_emis_wall_gfl     = 32   !< index in input list for wall emissivity, ground floor level
638    INTEGER(iwp) ::  ind_emis_wall_r       = 100  !< index in input list for wall emissivity, roof
639    INTEGER(iwp) ::  ind_emis_green_agfl   = 15   !< index in input list for green emissivity, above ground floor level
640    INTEGER(iwp) ::  ind_emis_green_gfl    = 34   !< index in input list for green emissivity, ground floor level
641    INTEGER(iwp) ::  ind_emis_green_r      = 116  !< index in input list for green emissivity, roof
642    INTEGER(iwp) ::  ind_emis_win_agfl     = 16   !< index in input list for window emissivity, above ground floor level
643    INTEGER(iwp) ::  ind_emis_win_gfl      = 33   !< index in input list for window emissivity, ground floor level
644    INTEGER(iwp) ::  ind_emis_win_r        = 113  !< index in input list for window emissivity, roof
645    INTEGER(iwp) ::  ind_gflh              = 20   !< index in input list for ground floor level height
646    INTEGER(iwp) ::  ind_green_frac_w_agfl = 2    !< index in input list for green fraction on wall, above ground floor level
647    INTEGER(iwp) ::  ind_green_frac_w_gfl  = 23   !< index in input list for green fraction on wall, ground floor level
648    INTEGER(iwp) ::  ind_green_frac_r_agfl = 3    !< index in input list for green fraction on roof, above ground floor level
649    INTEGER(iwp) ::  ind_green_frac_r_gfl  = 24   !< index in input list for green fraction on roof, ground floor level
650    INTEGER(iwp) ::  ind_hc1_agfl          = 6    !< index in input list for heat capacity at first wall layer,
651                                                  !< above ground floor level
652    INTEGER(iwp) ::  ind_hc1_gfl           = 26   !< index in input list for heat capacity at first wall layer, ground floor level
653    INTEGER(iwp) ::  ind_hc1_wall_r        = 94   !< index in input list for heat capacity at first wall layer, roof
654    INTEGER(iwp) ::  ind_hc1_win_agfl      = 83   !< index in input list for heat capacity at first window layer,
655                                                  !< above ground floor level
656    INTEGER(iwp) ::  ind_hc1_win_gfl       = 71   !< index in input list for heat capacity at first window layer,
657                                                  !< ground floor level
658    INTEGER(iwp) ::  ind_hc1_win_r         = 107  !< index in input list for heat capacity at first window layer, roof
659    INTEGER(iwp) ::  ind_hc2_agfl          = 7    !< index in input list for heat capacity at second wall layer,
660                                                  !< above ground floor level
661    INTEGER(iwp) ::  ind_hc2_gfl           = 27   !< index in input list for heat capacity at second wall layer, ground floor level
662    INTEGER(iwp) ::  ind_hc2_wall_r        = 95   !< index in input list for heat capacity at second wall layer, roof
663    INTEGER(iwp) ::  ind_hc2_win_agfl      = 84   !< index in input list for heat capacity at second window layer,
664                                                  !< above ground floor level
665    INTEGER(iwp) ::  ind_hc2_win_gfl       = 72   !< index in input list for heat capacity at second window layer,
666                                                  !< ground floor level
667    INTEGER(iwp) ::  ind_hc2_win_r         = 108  !< index in input list for heat capacity at second window layer, roof
668    INTEGER(iwp) ::  ind_hc3_agfl          = 8    !< index in input list for heat capacity at third wall layer,
669                                                  !< above ground floor level
670    INTEGER(iwp) ::  ind_hc3_gfl           = 28   !< index in input list for heat capacity at third wall layer, ground floor level
671    INTEGER(iwp) ::  ind_hc3_wall_r        = 96   !< index in input list for heat capacity at third wall layer, roof
672    INTEGER(iwp) ::  ind_hc3_win_agfl      = 85   !< index in input list for heat capacity at third window layer,
673                                                  !< above ground floor level
674    INTEGER(iwp) ::  ind_hc3_win_gfl       = 73   !< index in input list for heat capacity at third window layer,
675                                                  !< ground floor level
676    INTEGER(iwp) ::  ind_hc3_win_r         = 109  !< index in input list for heat capacity at third window layer, roof
677    INTEGER(iwp) ::  ind_indoor_target_temp_summer = 12
678    INTEGER(iwp) ::  ind_indoor_target_temp_winter = 13
679    INTEGER(iwp) ::  ind_lai_r_agfl        = 4    !< index in input list for LAI on roof, above ground floor level
680    INTEGER(iwp) ::  ind_lai_r_gfl         = 4  !< index in input list for LAI on roof, ground floor level
681    INTEGER(iwp) ::  ind_lai_w_agfl        = 5    !< index in input list for LAI on wall, above ground floor level
682    INTEGER(iwp) ::  ind_lai_w_gfl         = 25   !< index in input list for LAI on wall, ground floor level
683    INTEGER(iwp) ::  ind_lambda_surf       = 46   !< index in input list for thermal conductivity of wall surface
684    INTEGER(iwp) ::  ind_lambda_surf_green = 50   !< index in input list for thermal conductivity of green surface
685    INTEGER(iwp) ::  ind_lambda_surf_win   = 49   !< index in input list for thermal conductivity of window surface
686    INTEGER(iwp) ::  ind_tc1_agfl          = 9    !< index in input list for thermal conductivity at first wall layer,
687                                                  !< above ground floor level
688    INTEGER(iwp) ::  ind_tc1_gfl           = 29   !< index in input list for thermal conductivity at first wall layer,
689                                                  !< ground floor level
690    INTEGER(iwp) ::  ind_tc1_wall_r        = 97   !< index in input list for thermal conductivity at first wall layer, roof
691    INTEGER(iwp) ::  ind_tc1_win_agfl      = 86   !< index in input list for thermal conductivity at first window layer,
692                                                  !< above ground floor level
693    INTEGER(iwp) ::  ind_tc1_win_gfl       = 74   !< index in input list for thermal conductivity at first window layer,
694                                                  !< ground floor level
695    INTEGER(iwp) ::  ind_tc1_win_r         = 110  !< index in input list for thermal conductivity at first window layer, roof
696    INTEGER(iwp) ::  ind_tc2_agfl          = 10   !< index in input list for thermal conductivity at second wall layer,
697                                                  !< above ground floor level
698    INTEGER(iwp) ::  ind_tc2_gfl           = 30   !< index in input list for thermal conductivity at second wall layer,
699                                                  !< ground floor level
700    INTEGER(iwp) ::  ind_tc2_wall_r        = 98   !< index in input list for thermal conductivity at second wall layer, roof
701    INTEGER(iwp) ::  ind_tc2_win_agfl      = 87   !< index in input list for thermal conductivity at second window layer,
702                                                  !< above ground floor level
703    INTEGER(iwp) ::  ind_tc2_win_gfl       = 75   !< index in input list for thermal conductivity at second window layer,
704                                                  !< ground floor level
705    INTEGER(iwp) ::  ind_tc2_win_r         = 111  !< index in input list for thermal conductivity at second window layer,
706                                                  !< ground floor level
707    INTEGER(iwp) ::  ind_tc3_agfl          = 11   !< index in input list for thermal conductivity at third wall layer,
708                                                  !< above ground floor level
709    INTEGER(iwp) ::  ind_tc3_gfl           = 31   !< index in input list for thermal conductivity at third wall layer,
710                                                  !< ground floor level
711    INTEGER(iwp) ::  ind_tc3_wall_r        = 99   !< index in input list for thermal conductivity at third wall layer, roof
712    INTEGER(iwp) ::  ind_tc3_win_agfl      = 88   !< index in input list for thermal conductivity at third window layer,
713                                                  !< above ground floor level
714    INTEGER(iwp) ::  ind_tc3_win_gfl       = 76   !< index in input list for thermal conductivity at third window layer,
715                                                  !< ground floor level
716    INTEGER(iwp) ::  ind_tc3_win_r         = 112  !< index in input list for thermal conductivity at third window layer, roof
717    INTEGER(iwp) ::  ind_thick_1_agfl      = 41   !< index for wall layer thickness - 1st layer above ground floor level
718    INTEGER(iwp) ::  ind_thick_1_gfl       = 62   !< index for wall layer thickness - 1st layer ground floor level
719    INTEGER(iwp) ::  ind_thick_1_wall_r    = 90   !< index for wall layer thickness - 1st layer roof
720    INTEGER(iwp) ::  ind_thick_1_win_agfl  = 79   !< index for window layer thickness - 1st layer above ground floor level
721    INTEGER(iwp) ::  ind_thick_1_win_gfl   = 67   !< index for window layer thickness - 1st layer ground floor level
722    INTEGER(iwp) ::  ind_thick_1_win_r     = 103  !< index for window layer thickness - 1st layer roof
723    INTEGER(iwp) ::  ind_thick_2_agfl      = 42   !< index for wall layer thickness - 2nd layer above ground floor level
724    INTEGER(iwp) ::  ind_thick_2_gfl       = 63   !< index for wall layer thickness - 2nd layer ground floor level
725    INTEGER(iwp) ::  ind_thick_2_wall_r    = 91   !< index for wall layer thickness - 2nd layer roof
726    INTEGER(iwp) ::  ind_thick_2_win_agfl  = 80   !< index for window layer thickness - 2nd layer above ground floor level
727    INTEGER(iwp) ::  ind_thick_2_win_gfl   = 68   !< index for window layer thickness - 2nd layer ground floor level
728    INTEGER(iwp) ::  ind_thick_2_win_r     = 104  !< index for window layer thickness - 2nd layer roof
729    INTEGER(iwp) ::  ind_thick_3_agfl      = 43   !< index for wall layer thickness - 3rd layer above ground floor level
730    INTEGER(iwp) ::  ind_thick_3_gfl       = 64   !< index for wall layer thickness - 3rd layer ground floor level
731    INTEGER(iwp) ::  ind_thick_3_wall_r    = 92   !< index for wall layer thickness - 3rd layer roof
732    INTEGER(iwp) ::  ind_thick_3_win_agfl  = 81   !< index for window layer thickness - 3rd layer above ground floor level
733    INTEGER(iwp) ::  ind_thick_3_win_gfl   = 69   !< index for window layer thickness - 3rd layer ground floor level 
734    INTEGER(iwp) ::  ind_thick_3_win_r     = 105  !< index for window layer thickness - 3rd layer roof
735    INTEGER(iwp) ::  ind_thick_4_agfl      = 44   !< index for wall layer thickness - 4th layer above ground floor level
736    INTEGER(iwp) ::  ind_thick_4_gfl       = 65   !< index for wall layer thickness - 4th layer ground floor level
737    INTEGER(iwp) ::  ind_thick_4_wall_r    = 93   !< index for wall layer thickness - 4st layer roof
738    INTEGER(iwp) ::  ind_thick_4_win_agfl  = 82   !< index for window layer thickness - 4th layer above ground floor level
739    INTEGER(iwp) ::  ind_thick_4_win_gfl   = 70   !< index for window layer thickness - 4th layer ground floor level
740    INTEGER(iwp) ::  ind_thick_4_win_r     = 106  !< index for window layer thickness - 4th layer roof
741    INTEGER(iwp) ::  ind_trans_agfl        = 17   !< index in input list for window transmissivity, above ground floor level
742    INTEGER(iwp) ::  ind_trans_gfl         = 35   !< index in input list for window transmissivity, ground floor level
743    INTEGER(iwp) ::  ind_trans_r           = 114  !< index in input list for window transmissivity, roof
744    INTEGER(iwp) ::  ind_wall_frac_agfl    = 0    !< index in input list for wall fraction, above ground floor level
745    INTEGER(iwp) ::  ind_wall_frac_gfl     = 21   !< index in input list for wall fraction, ground floor level
746    INTEGER(iwp) ::  ind_wall_frac_r       = 89   !< index in input list for wall fraction, roof
747    INTEGER(iwp) ::  ind_win_frac_agfl     = 1    !< index in input list for window fraction, above ground floor level
748    INTEGER(iwp) ::  ind_win_frac_gfl      = 22   !< index in input list for window fraction, ground floor level
749    INTEGER(iwp) ::  ind_win_frac_r        = 102  !< index in input list for window fraction, roof
750    INTEGER(iwp) ::  ind_z0_agfl           = 18   !< index in input list for z0, above ground floor level
751    INTEGER(iwp) ::  ind_z0_gfl            = 36   !< index in input list for z0, ground floor level
752    INTEGER(iwp) ::  ind_z0qh_agfl         = 19   !< index in input list for z0h / z0q, above ground floor level
753    INTEGER(iwp) ::  ind_z0qh_gfl          = 37   !< index in input list for z0h / z0q, ground floor level
754    INTEGER(iwp) ::  ind_green_type_roof   = 118  !< index in input list for type of green roof
755
756
757    REAL(wp)  ::  roof_height_limit = 4.0_wp         !< height for distinguish between land surfaces and roofs
758    REAL(wp)  ::  ground_floor_level = 4.0_wp        !< default ground floor level
759
760
761    CHARACTER(37), DIMENSION(0:7), PARAMETER :: building_type_name = (/     &
762                                   'user-defined                         ', &  !< type 0
763                                   'residential - 1950                   ', &  !< type  1
764                                   'residential 1951 - 2000              ', &  !< type  2
765                                   'residential 2001 -                   ', &  !< type  3
766                                   'office - 1950                        ', &  !< type  4
767                                   'office 1951 - 2000                   ', &  !< type  5
768                                   'office 2001 -                        ', &  !< type  6
769                                   'bridges                              '  &  !< type  7
770                                                                     /)
771
772
773!
774!-- Building facade/wall/green/window properties (partly according to PIDS).
775!-- Initialization of building_pars is outsourced to usm_init_pars. This is
776!-- needed because of the huge number of attributes given in building_pars
777!-- (>700), while intel and gfortran compiler have hard limit of continuation
778!-- lines of 511.
779    REAL(wp), DIMENSION(0:133,1:7) ::  building_pars
780!
781!-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls.
782    TYPE t_surf_vertical
783       REAL(wp), DIMENSION(:), ALLOCATABLE         :: t
784    END TYPE t_surf_vertical
785!
786!-- Type for wall temperatures at vertical walls. Is not necessary for horizontal walls.
787    TYPE t_wall_vertical
788       REAL(wp), DIMENSION(:,:), ALLOCATABLE       :: t
789    END TYPE t_wall_vertical
790
791    TYPE surf_type_usm
792       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_usm_1d  !< 1D prognostic variable
793       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_usm_2d  !< 2D prognostic variable
794    END TYPE surf_type_usm
795   
796    TYPE(surf_type_usm), POINTER  ::  m_liq_usm_h,        &  !< liquid water reservoir (m), horizontal surface elements
797                                      m_liq_usm_h_p          !< progn. liquid water reservoir (m), horizontal surface elements
798
799    TYPE(surf_type_usm), TARGET   ::  m_liq_usm_h_1,      &  !<
800                                      m_liq_usm_h_2          !<
801
802    TYPE(surf_type_usm), DIMENSION(:), POINTER  ::        &
803                                      m_liq_usm_v,        &  !< liquid water reservoir (m), vertical surface elements
804                                      m_liq_usm_v_p          !< progn. liquid water reservoir (m), vertical surface elements
805
806    TYPE(surf_type_usm), DIMENSION(0:3), TARGET   ::      &
807                                      m_liq_usm_v_1,      &  !<
808                                      m_liq_usm_v_2          !<
809
810    TYPE(surf_type_usm), TARGET ::  tm_liq_usm_h_m      !< liquid water reservoir tendency (m), horizontal surface elements
811    TYPE(surf_type_usm), DIMENSION(0:3), TARGET ::  tm_liq_usm_v_m      !< liquid water reservoir tendency (m),
812                                                                        !< vertical surface elements
813
814!
815!-- anthropogenic heat sources
816    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE        ::  aheat             !< daily average of anthropogenic heat (W/m2)
817    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  aheatprof         !< diurnal profiles of anthropogenic heat
818                                                                         !< for particular layers
819    INTEGER(iwp)                                   ::  naheatlayers = 1  !< number of layers of anthropogenic heat
820
821!
822!-- wall surface model
823!-- wall surface model constants
824    INTEGER(iwp), PARAMETER                        :: nzb_wall = 0       !< inner side of the wall model (to be switched)
825    INTEGER(iwp), PARAMETER                        :: nzt_wall = 3       !< outer side of the wall model (to be switched)
826    INTEGER(iwp), PARAMETER                        :: nzw = 4            !< number of wall layers (fixed for now)
827
828    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default        = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
829    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
830    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green  = (/0.25_wp,   0.5_wp,    0.75_wp,  1.0_wp /)
831                                                                         !< normalized soil, wall and roof, window and
832                                                                         !<green layer depths (m/m)
833
834    REAL(wp)                                       :: wall_inner_temperature   = 295.0_wp    !< temperature of the inner wall
835                                                                                             !< surface (~22 degrees C) (K)
836    REAL(wp)                                       :: roof_inner_temperature   = 295.0_wp    !< temperature of the inner roof
837                                                                                             !< surface (~22 degrees C) (K)
838    REAL(wp)                                       :: soil_inner_temperature   = 288.0_wp    !< temperature of the deep soil
839                                                                                             !< (~15 degrees C) (K)
840    REAL(wp)                                       :: window_inner_temperature = 295.0_wp    !< temperature of the inner window
841                                                                                             !< surface (~22 degrees C) (K)
842
843    REAL(wp)                                       :: m_total = 0.0_wp  !< weighted total water content of the soil (m3/m3)
844    INTEGER(iwp)                                   :: soil_type
845
846!
847!-- surface and material model variables for walls, ground, roofs
848    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn                !< normalized wall layer depths (m)
849    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_window         !< normalized window layer depths (m)
850    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_green          !< normalized green layer depths (m)
851
852    REAL(wp), DIMENSION(:), POINTER                :: t_surf_wall_h
853    REAL(wp), DIMENSION(:), POINTER                :: t_surf_wall_h_p 
854    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h
855    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h_p 
856    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h
857    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h_p 
858
859    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_wall_h_1
860    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_wall_h_2
861    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_1
862    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_2
863    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_1
864    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_2
865
866    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v
867    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_wall_v_p
868    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v
869    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_window_v_p
870    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v
871    TYPE(t_surf_vertical), DIMENSION(:), POINTER   ::  t_surf_green_v_p
872
873    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_wall_v_1
874    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_wall_v_2
875    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_1
876    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_2
877    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_1
878    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_2
879
880!
881!-- Energy balance variables
882!-- parameters of the land, roof and wall surfaces
883
884    REAL(wp), DIMENSION(:,:), POINTER                :: t_wall_h, t_wall_h_p
885    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_1, t_wall_h_2
886    REAL(wp), DIMENSION(:,:), POINTER                :: t_window_h, t_window_h_p
887    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_1, t_window_h_2
888    REAL(wp), DIMENSION(:,:), POINTER                :: t_green_h, t_green_h_p
889    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_1, t_green_h_2
890    REAL(wp), DIMENSION(:,:), POINTER                :: swc_h, rootfr_h, wilt_h, fc_h, swc_sat_h, swc_h_p, swc_res_h
891    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: swc_h_1, rootfr_h_1, &
892                                                        wilt_h_1, fc_h_1, swc_sat_h_1, swc_h_2, swc_res_h_1
893   
894
895    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_wall_v, t_wall_v_p
896    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_1, t_wall_v_2
897    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_window_v, t_window_v_p
898    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_1, t_window_v_2
899    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_green_v, t_green_v_p
900    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_1, t_green_v_2
901    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: swc_v, swc_v_p
902    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: swc_v_1, swc_v_2
903
904!
905!-- Surface and material parameters classes (surface_type)
906!-- albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
907    INTEGER(iwp)                                   :: n_surface_types       !< number of the wall type categories
908    INTEGER(iwp), PARAMETER                        :: n_surface_params = 9  !< number of parameters for each type of the wall
909    INTEGER(iwp), PARAMETER                        :: ialbedo  = 1          !< albedo of the surface
910    INTEGER(iwp), PARAMETER                        :: iemiss   = 2          !< emissivity of the surface
911    INTEGER(iwp), PARAMETER                        :: ilambdas = 3          !< heat conductivity lambda S between surface
912                                                                            !< and material ( W m-2 K-1 )
913    INTEGER(iwp), PARAMETER                        :: irough   = 4          !< roughness length z0 for movements
914    INTEGER(iwp), PARAMETER                        :: iroughh  = 5          !< roughness length z0h for scalars
915                                                                            !< (heat, humidity,...)
916    INTEGER(iwp), PARAMETER                        :: icsurf   = 6          !< Surface skin layer heat capacity (J m-2 K-1 )
917    INTEGER(iwp), PARAMETER                        :: ithick   = 7          !< thickness of the surface (wall, roof, land)  ( m )
918    INTEGER(iwp), PARAMETER                        :: irhoC    = 8          !< volumetric heat capacity rho*C of
919                                                                            !< the material ( J m-3 K-1 )
920    INTEGER(iwp), PARAMETER                        :: ilambdah = 9          !< thermal conductivity lambda H
921                                                                            !< of the wall (W m-1 K-1 )
922    CHARACTER(12), DIMENSION(:), ALLOCATABLE       :: surface_type_names    !< names of wall types (used only for reports)
923    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        :: surface_type_codes    !< codes of wall types
924    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: surface_params        !< parameters of wall types
925
926!
927!-- interfaces of subroutines accessed from outside of this module
928    INTERFACE usm_3d_data_averaging
929       MODULE PROCEDURE usm_3d_data_averaging
930    END INTERFACE usm_3d_data_averaging
931
932    INTERFACE usm_boundary_condition
933       MODULE PROCEDURE usm_boundary_condition
934    END INTERFACE usm_boundary_condition
935
936    INTERFACE usm_check_data_output
937       MODULE PROCEDURE usm_check_data_output
938    END INTERFACE usm_check_data_output
939   
940    INTERFACE usm_check_parameters
941       MODULE PROCEDURE usm_check_parameters
942    END INTERFACE usm_check_parameters
943   
944    INTERFACE usm_data_output_3d
945       MODULE PROCEDURE usm_data_output_3d
946    END INTERFACE usm_data_output_3d
947   
948    INTERFACE usm_define_netcdf_grid
949       MODULE PROCEDURE usm_define_netcdf_grid
950    END INTERFACE usm_define_netcdf_grid
951
952    INTERFACE usm_init
953       MODULE PROCEDURE usm_init
954    END INTERFACE usm_init
955
956    INTERFACE usm_init_arrays
957       MODULE PROCEDURE usm_init_arrays
958    END INTERFACE usm_init_arrays
959
960    INTERFACE usm_material_heat_model
961       MODULE PROCEDURE usm_material_heat_model
962    END INTERFACE usm_material_heat_model
963   
964    INTERFACE usm_green_heat_model
965       MODULE PROCEDURE usm_green_heat_model
966    END INTERFACE usm_green_heat_model
967   
968    INTERFACE usm_parin
969       MODULE PROCEDURE usm_parin
970    END INTERFACE usm_parin
971
972    INTERFACE usm_rrd_local 
973       MODULE PROCEDURE usm_rrd_local
974    END INTERFACE usm_rrd_local
975
976    INTERFACE usm_surface_energy_balance
977       MODULE PROCEDURE usm_surface_energy_balance
978    END INTERFACE usm_surface_energy_balance
979   
980    INTERFACE usm_swap_timelevel
981       MODULE PROCEDURE usm_swap_timelevel
982    END INTERFACE usm_swap_timelevel
983       
984    INTERFACE usm_wrd_local
985       MODULE PROCEDURE usm_wrd_local
986    END INTERFACE usm_wrd_local
987
988   
989    SAVE
990
991    PRIVATE 
992
993!
994!-- Public functions
995    PUBLIC usm_boundary_condition, usm_check_parameters, usm_init,               &
996           usm_rrd_local,                                                        & 
997           usm_surface_energy_balance, usm_material_heat_model,                  &
998           usm_swap_timelevel, usm_check_data_output, usm_3d_data_averaging,     &
999           usm_data_output_3d, usm_define_netcdf_grid, usm_parin,                &
1000           usm_wrd_local, usm_init_arrays
1001
1002!
1003!-- Public parameters, constants and initial values
1004    PUBLIC usm_anthropogenic_heat, usm_material_model, usm_wall_mod, &
1005           usm_green_heat_model, building_pars,                      &
1006           nzb_wall, nzt_wall, t_wall_h, t_wall_v,                   &
1007           t_window_h, t_window_v, building_type
1008
1009
1010
1011 CONTAINS
1012
1013!------------------------------------------------------------------------------!
1014! Description:
1015! ------------
1016!> This subroutine creates the necessary indices of the urban surfaces
1017!> and plant canopy and it allocates the needed arrays for USM
1018!------------------------------------------------------------------------------!
1019    SUBROUTINE usm_init_arrays
1020   
1021        IMPLICIT NONE
1022       
1023        INTEGER(iwp) ::  l
1024
1025        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'start' )
1026
1027!
1028!--     Allocate radiation arrays which are part of the new data type.
1029!--     For horizontal surfaces.
1030        ALLOCATE ( surf_usm_h%surfhf(1:surf_usm_h%ns)    )
1031        ALLOCATE ( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
1032!
1033!--     For vertical surfaces
1034        DO  l = 0, 3
1035           ALLOCATE ( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns)    )
1036           ALLOCATE ( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
1037        ENDDO
1038
1039!
1040!--     Wall surface model
1041!--     allocate arrays for wall surface model and define pointers
1042!--     allocate array of wall types and wall parameters
1043        ALLOCATE ( surf_usm_h%surface_types(1:surf_usm_h%ns)      )
1044        ALLOCATE ( surf_usm_h%building_type(1:surf_usm_h%ns)      )
1045        ALLOCATE ( surf_usm_h%building_type_name(1:surf_usm_h%ns) )
1046        surf_usm_h%building_type      = 0
1047        surf_usm_h%building_type_name = 'none'
1048        DO  l = 0, 3
1049           ALLOCATE ( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns)      )
1050           ALLOCATE ( surf_usm_v(l)%building_type(1:surf_usm_v(l)%ns)      )
1051           ALLOCATE ( surf_usm_v(l)%building_type_name(1:surf_usm_v(l)%ns) )
1052           surf_usm_v(l)%building_type      = 0
1053           surf_usm_v(l)%building_type_name = 'none'
1054        ENDDO
1055!
1056!--     Allocate albedo_type and albedo. Each surface element
1057!--     has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction.
1058        ALLOCATE ( surf_usm_h%albedo_type(0:2,1:surf_usm_h%ns) )
1059        ALLOCATE ( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)      )
1060        surf_usm_h%albedo_type = albedo_type
1061        DO  l = 0, 3
1062           ALLOCATE ( surf_usm_v(l)%albedo_type(0:2,1:surf_usm_v(l)%ns) )
1063           ALLOCATE ( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns)      )
1064           surf_usm_v(l)%albedo_type = albedo_type
1065        ENDDO       
1066
1067!
1068!--     Allocate indoor target temperature for summer and winter
1069        ALLOCATE ( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
1070        ALLOCATE ( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
1071        DO  l = 0, 3
1072           ALLOCATE ( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
1073           ALLOCATE ( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
1074        ENDDO
1075!
1076!--     In case the indoor model is applied, allocate memory for waste heat
1077!--     and indoor temperature.
1078        IF ( indoor_model )  THEN
1079           ALLOCATE ( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
1080           surf_usm_h%waste_heat = 0.0_wp
1081           DO  l = 0, 3
1082              ALLOCATE ( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
1083              surf_usm_v(l)%waste_heat = 0.0_wp
1084           ENDDO
1085        ENDIF
1086!
1087!--     Allocate flag indicating ground floor level surface elements
1088        ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) ) 
1089        DO  l = 0, 3
1090           ALLOCATE ( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
1091        ENDDO   
1092!
1093!--      Allocate arrays for relative surface fraction.
1094!--      0 - wall fraction, 1 - green fraction, 2 - window fraction
1095         ALLOCATE ( surf_usm_h%frac(0:2,1:surf_usm_h%ns) )
1096         surf_usm_h%frac = 0.0_wp
1097         DO  l = 0, 3
1098            ALLOCATE ( surf_usm_v(l)%frac(0:2,1:surf_usm_v(l)%ns) )
1099            surf_usm_v(l)%frac = 0.0_wp
1100         ENDDO
1101
1102!
1103!--     wall and roof surface parameters. First for horizontal surfaces
1104        ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)        )
1105        ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)        )
1106        ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
1107        ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns)  )
1108        ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)          )
1109        ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns)   )
1110        ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns)    )
1111        ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns)     )
1112        ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns)                )
1113        ALLOCATE ( surf_usm_h%emissivity(0:2,1:surf_usm_h%ns)     )
1114        ALLOCATE ( surf_usm_h%r_a(1:surf_usm_h%ns)                )
1115        ALLOCATE ( surf_usm_h%r_a_green(1:surf_usm_h%ns)          )
1116        ALLOCATE ( surf_usm_h%r_a_window(1:surf_usm_h%ns)         )
1117        ALLOCATE ( surf_usm_h%green_type_roof(1:surf_usm_h%ns)    )
1118        ALLOCATE ( surf_usm_h%r_s(1:surf_usm_h%ns)                )
1119       
1120!
1121!--     For vertical surfaces.
1122        DO  l = 0, 3
1123           ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)        )
1124           ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)          )
1125           ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
1126           ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns)   )
1127           ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns)  )
1128           ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns)    )
1129           ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns)     )
1130           ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns)                )
1131           ALLOCATE ( surf_usm_v(l)%emissivity(0:2,1:surf_usm_v(l)%ns)     )
1132           ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns)                )
1133           ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns)          )
1134           ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns)         )           
1135           ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns)                )
1136        ENDDO
1137
1138!       
1139!--     allocate wall and roof material parameters. First for horizontal surfaces
1140        ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)                    )
1141        ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
1142        ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns)                   )
1143        ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1144        ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns)      )
1145        ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1146        ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1147        ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1148        ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
1149
1150        ALLOCATE ( surf_usm_h%rho_c_total_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1151        ALLOCATE ( surf_usm_h%n_vg_green(1:surf_usm_h%ns)                             )
1152        ALLOCATE ( surf_usm_h%alpha_vg_green(1:surf_usm_h%ns)                         )
1153        ALLOCATE ( surf_usm_h%l_vg_green(1:surf_usm_h%ns)                             )
1154        ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1155        ALLOCATE ( surf_usm_h%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1156        ALLOCATE ( surf_usm_h%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1157        ALLOCATE ( surf_usm_h%tswc_h_m(nzb_wall:nzt_wall,1:surf_usm_h%ns)             )
1158
1159!
1160!--     For vertical surfaces.
1161        DO  l = 0, 3
1162           ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns)                    )
1163           ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns)                  )
1164           ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns)                   )
1165           ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1166           ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)      )
1167           ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1168           ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1169           ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1170           ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)     )
1171        ENDDO
1172
1173!
1174!--     allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
1175        ALLOCATE ( surf_usm_h%g_d(1:surf_usm_h%ns)              )
1176        ALLOCATE ( surf_usm_h%c_liq(1:surf_usm_h%ns)            )
1177        ALLOCATE ( surf_usm_h%qsws_liq(1:surf_usm_h%ns)         )
1178        ALLOCATE ( surf_usm_h%qsws_veg(1:surf_usm_h%ns)         )
1179        ALLOCATE ( surf_usm_h%r_canopy(1:surf_usm_h%ns)         )
1180        ALLOCATE ( surf_usm_h%r_canopy_min(1:surf_usm_h%ns)     )
1181        ALLOCATE ( surf_usm_h%pt_10cm(1:surf_usm_h%ns)          ) 
1182
1183!
1184!--     For vertical surfaces.
1185        DO  l = 0, 3
1186          ALLOCATE ( surf_usm_v(l)%g_d(1:surf_usm_v(l)%ns)              )
1187          ALLOCATE ( surf_usm_v(l)%c_liq(1:surf_usm_v(l)%ns)            )
1188          ALLOCATE ( surf_usm_v(l)%qsws_liq(1:surf_usm_v(l)%ns)         )
1189          ALLOCATE ( surf_usm_v(l)%qsws_veg(1:surf_usm_v(l)%ns)         )
1190          ALLOCATE ( surf_usm_v(l)%r_canopy(1:surf_usm_v(l)%ns)         )
1191          ALLOCATE ( surf_usm_v(l)%r_canopy_min(1:surf_usm_v(l)%ns)     )
1192          ALLOCATE ( surf_usm_v(l)%pt_10cm(1:surf_usm_v(l)%ns)          )
1193        ENDDO
1194
1195!
1196!--     allocate wall and roof layers sizes. For horizontal surfaces.
1197        ALLOCATE ( zwn(nzb_wall:nzt_wall)                                        )
1198        ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)       )
1199        ALLOCATE ( zwn_window(nzb_wall:nzt_wall)                                 )
1200        ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1201        ALLOCATE ( zwn_green(nzb_wall:nzt_wall)                                  )
1202        ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1203        ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
1204        ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
1205        ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1206        ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns)              )
1207        ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
1208        ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1209        ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1210        ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
1211        ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
1212        ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
1213        ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
1214        ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
1215
1216!
1217!--     For vertical surfaces.
1218        DO  l = 0, 3
1219           ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)       )
1220           ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1221           ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1222           ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
1223           ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
1224           ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1225           ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)              )
1226           ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
1227           ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1228           ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1229           ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)       )
1230           ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
1231           ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
1232           ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
1233           ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
1234        ENDDO
1235
1236!
1237!--     allocate wall and roof temperature arrays, for horizontal walls
1238!
1239!--     Allocate if required. Note, in case of restarts, some of these arrays
1240!--     might be already allocated.
1241        IF ( .NOT. ALLOCATED( t_surf_wall_h_1 ) )                              &
1242           ALLOCATE ( t_surf_wall_h_1(1:surf_usm_h%ns) )
1243        IF ( .NOT. ALLOCATED( t_surf_wall_h_2 ) )                              &
1244           ALLOCATE ( t_surf_wall_h_2(1:surf_usm_h%ns) )
1245        IF ( .NOT. ALLOCATED( t_wall_h_1 ) )                                   &           
1246           ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1247        IF ( .NOT. ALLOCATED( t_wall_h_2 ) )                                   &           
1248           ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1249        IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) )                            &
1250           ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
1251        IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) )                            &
1252           ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
1253        IF ( .NOT. ALLOCATED( t_window_h_1 ) )                                 &           
1254           ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1255        IF ( .NOT. ALLOCATED( t_window_h_2 ) )                                 &           
1256           ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1257        IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) )                             &
1258           ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
1259        IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) )                             &
1260           ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
1261        IF ( .NOT. ALLOCATED( t_green_h_1 ) )                                  &           
1262           ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1263        IF ( .NOT. ALLOCATED( t_green_h_2 ) )                                  &           
1264           ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
1265        IF ( .NOT. ALLOCATED( swc_h_1 ) )                                      &           
1266           ALLOCATE ( swc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1267        IF ( .NOT. ALLOCATED( swc_sat_h_1 ) )                                  &           
1268           ALLOCATE ( swc_sat_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1269        IF ( .NOT. ALLOCATED( swc_res_h_1 ) )                                  &           
1270           ALLOCATE ( swc_res_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1271        IF ( .NOT. ALLOCATED( swc_h_2 ) )                                      &           
1272           ALLOCATE ( swc_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1273        IF ( .NOT. ALLOCATED( rootfr_h_1 ) )                                   &           
1274           ALLOCATE ( rootfr_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1275        IF ( .NOT. ALLOCATED( wilt_h_1 ) )                                     &           
1276           ALLOCATE ( wilt_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1277        IF ( .NOT. ALLOCATED( fc_h_1 ) )                                       &           
1278           ALLOCATE ( fc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
1279
1280        IF ( .NOT. ALLOCATED( m_liq_usm_h_1%var_usm_1d ) )                     &
1281           ALLOCATE ( m_liq_usm_h_1%var_usm_1d(1:surf_usm_h%ns) )
1282        IF ( .NOT. ALLOCATED( m_liq_usm_h_2%var_usm_1d ) )                     &
1283           ALLOCATE ( m_liq_usm_h_2%var_usm_1d(1:surf_usm_h%ns) )
1284           
1285!           
1286!--     initial assignment of the pointers
1287        t_wall_h    => t_wall_h_1;   t_wall_h_p   => t_wall_h_2
1288        t_window_h  => t_window_h_1; t_window_h_p => t_window_h_2
1289        t_green_h   => t_green_h_1;  t_green_h_p  => t_green_h_2
1290        t_surf_wall_h   => t_surf_wall_h_1;   t_surf_wall_h_p   => t_surf_wall_h_2           
1291        t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2 
1292        t_surf_green_h  => t_surf_green_h_1;  t_surf_green_h_p  => t_surf_green_h_2           
1293        m_liq_usm_h     => m_liq_usm_h_1;     m_liq_usm_h_p     => m_liq_usm_h_2
1294        swc_h     => swc_h_1; swc_h_p => swc_h_2
1295        swc_sat_h => swc_sat_h_1
1296        swc_res_h => swc_res_h_1
1297        rootfr_h  => rootfr_h_1
1298        wilt_h    => wilt_h_1
1299        fc_h      => fc_h_1
1300
1301!
1302!--     allocate wall and roof temperature arrays, for vertical walls if required
1303!
1304!--     Allocate if required. Note, in case of restarts, some of these arrays
1305!--     might be already allocated.
1306        DO  l = 0, 3
1307           IF ( .NOT. ALLOCATED( t_surf_wall_v_1(l)%t ) )                      &
1308              ALLOCATE ( t_surf_wall_v_1(l)%t(1:surf_usm_v(l)%ns) )
1309           IF ( .NOT. ALLOCATED( t_surf_wall_v_2(l)%t ) )                      &
1310              ALLOCATE ( t_surf_wall_v_2(l)%t(1:surf_usm_v(l)%ns) )
1311           IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) )                           &           
1312              ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1313           IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) )                           &           
1314              ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1315           IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) )                    &
1316              ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
1317           IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) )                    &
1318              ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
1319           IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                         &           
1320              ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1321           IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) )                         &           
1322              ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1323           IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) )                     &
1324              ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
1325           IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) )                     &
1326              ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
1327           IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                          &           
1328              ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1329           IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) )                          &           
1330              ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1331           IF ( .NOT. ALLOCATED( m_liq_usm_v_1(l)%var_usm_1d ) )               &
1332              ALLOCATE ( m_liq_usm_v_1(l)%var_usm_1d(1:surf_usm_v(l)%ns) )
1333           IF ( .NOT. ALLOCATED( m_liq_usm_v_2(l)%var_usm_1d ) )               &
1334              ALLOCATE ( m_liq_usm_v_2(l)%var_usm_1d(1:surf_usm_v(l)%ns) )
1335           IF ( .NOT. ALLOCATED( swc_v_1(l)%t ) )                              &           
1336              ALLOCATE ( swc_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1337           IF ( .NOT. ALLOCATED( swc_v_2(l)%t ) )                              &           
1338              ALLOCATE ( swc_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
1339        ENDDO
1340!
1341!--     initial assignment of the pointers
1342        t_wall_v        => t_wall_v_1;        t_wall_v_p        => t_wall_v_2
1343        t_surf_wall_v   => t_surf_wall_v_1;   t_surf_wall_v_p   => t_surf_wall_v_2
1344        t_window_v      => t_window_v_1;      t_window_v_p      => t_window_v_2
1345        t_green_v       => t_green_v_1;       t_green_v_p       => t_green_v_2
1346        t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
1347        t_surf_green_v  => t_surf_green_v_1;  t_surf_green_v_p  => t_surf_green_v_2
1348        m_liq_usm_v     => m_liq_usm_v_1;     m_liq_usm_v_p     => m_liq_usm_v_2
1349        swc_v           => swc_v_1;           swc_v_p           => swc_v_2
1350
1351!
1352!--     Allocate intermediate timestep arrays. For horizontal surfaces.
1353        ALLOCATE ( surf_usm_h%tt_surface_wall_m(1:surf_usm_h%ns)               )
1354        ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)   )
1355        ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns)             )
1356        ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1357        ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
1358        ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns)              )
1359
1360!
1361!--    Allocate intermediate timestep arrays
1362!--    Horizontal surfaces
1363       ALLOCATE ( tm_liq_usm_h_m%var_usm_1d(1:surf_usm_h%ns)                   )
1364!
1365!--    Horizontal surfaces
1366       DO  l = 0, 3
1367          ALLOCATE ( tm_liq_usm_v_m(l)%var_usm_1d(1:surf_usm_v(l)%ns)          )
1368       ENDDO 
1369       
1370!
1371!--     Set inital values for prognostic quantities
1372        IF ( ALLOCATED( surf_usm_h%tt_surface_wall_m )   )  surf_usm_h%tt_surface_wall_m   = 0.0_wp
1373        IF ( ALLOCATED( surf_usm_h%tt_wall_m )           )  surf_usm_h%tt_wall_m           = 0.0_wp
1374        IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) )  surf_usm_h%tt_surface_window_m = 0.0_wp
1375        IF ( ALLOCATED( surf_usm_h%tt_window_m    )      )  surf_usm_h%tt_window_m         = 0.0_wp
1376        IF ( ALLOCATED( surf_usm_h%tt_green_m    )       )  surf_usm_h%tt_green_m          = 0.0_wp
1377        IF ( ALLOCATED( surf_usm_h%tt_surface_green_m )  )  surf_usm_h%tt_surface_green_m  = 0.0_wp
1378!
1379!--     Now, for vertical surfaces
1380        DO  l = 0, 3
1381           ALLOCATE ( surf_usm_v(l)%tt_surface_wall_m(1:surf_usm_v(l)%ns)               )
1382           ALLOCATE ( surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)   )
1383           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_wall_m ) )  surf_usm_v(l)%tt_surface_wall_m = 0.0_wp
1384           IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m    ) )  surf_usm_v(l)%tt_wall_m    = 0.0_wp
1385           ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns)             )
1386           ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1387           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) )  surf_usm_v(l)%tt_surface_window_m = 0.0_wp
1388           IF ( ALLOCATED( surf_usm_v(l)%tt_window_m  ) )  surf_usm_v(l)%tt_window_m    = 0.0_wp
1389           ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns)              )
1390           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) )  surf_usm_v(l)%tt_surface_green_m = 0.0_wp
1391           ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)  )
1392           IF ( ALLOCATED( surf_usm_v(l)%tt_green_m   ) )  surf_usm_v(l)%tt_green_m    = 0.0_wp
1393        ENDDO
1394!
1395!--     allocate wall heat flux output array and set initial values. For horizontal surfaces
1396!        ALLOCATE ( surf_usm_h%wshf(1:surf_usm_h%ns)    )  !can be removed
1397        ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
1398        ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
1399        ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
1400        ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
1401        ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
1402        ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
1403        IF ( ALLOCATED( surf_usm_h%wshf    ) )  surf_usm_h%wshf    = 0.0_wp
1404        IF ( ALLOCATED( surf_usm_h%wshf_eb ) )  surf_usm_h%wshf_eb = 0.0_wp
1405        IF ( ALLOCATED( surf_usm_h%wghf_eb ) )  surf_usm_h%wghf_eb = 0.0_wp
1406        IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) )  surf_usm_h%wghf_eb_window = 0.0_wp
1407        IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) )  surf_usm_h%wghf_eb_green = 0.0_wp
1408        IF ( ALLOCATED( surf_usm_h%iwghf_eb ) )  surf_usm_h%iwghf_eb = 0.0_wp
1409        IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) )  surf_usm_h%iwghf_eb_window = 0.0_wp
1410!
1411!--     Now, for vertical surfaces
1412        DO  l = 0, 3
1413!           ALLOCATE ( surf_usm_v(l)%wshf(1:surf_usm_v(l)%ns)    )    ! can be removed
1414           ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
1415           ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
1416           ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
1417           ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
1418           ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
1419           ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
1420           IF ( ALLOCATED( surf_usm_v(l)%wshf    ) )  surf_usm_v(l)%wshf    = 0.0_wp
1421           IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) )  surf_usm_v(l)%wshf_eb = 0.0_wp
1422           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) )  surf_usm_v(l)%wghf_eb = 0.0_wp
1423           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) )  surf_usm_v(l)%wghf_eb_window = 0.0_wp
1424           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) )  surf_usm_v(l)%wghf_eb_green = 0.0_wp
1425           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) )  surf_usm_v(l)%iwghf_eb = 0.0_wp
1426           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) )  surf_usm_v(l)%iwghf_eb_window = 0.0_wp
1427        ENDDO
1428
1429        IF ( debug_output )  CALL debug_message( 'usm_init_arrays', 'end' )
1430       
1431    END SUBROUTINE usm_init_arrays
1432
1433
1434!------------------------------------------------------------------------------!
1435! Description:
1436! ------------
1437!> Sum up and time-average urban surface output quantities as well as allocate
1438!> the array necessary for storing the average.
1439!------------------------------------------------------------------------------!
1440    SUBROUTINE usm_3d_data_averaging( mode, variable )
1441
1442        IMPLICIT NONE
1443
1444        CHARACTER(LEN=*), INTENT(IN) ::  mode
1445        CHARACTER(LEN=*), INTENT(IN) :: variable
1446 
1447        INTEGER(iwp)                                       :: i, j, k, l, m, ids, idsint, iwl, istat  !< runnin indices
1448        CHARACTER(LEN=varnamelength)                       :: var                                     !< trimmed variable
1449        INTEGER(iwp), PARAMETER                            :: nd = 5                                  !< number of directions
1450        CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
1451        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
1452
1453        IF ( variable(1:4) == 'usm_' )  THEN  ! is such a check really rquired?
1454
1455!
1456!--     find the real name of the variable
1457        ids = -1
1458        l = -1
1459        var = TRIM(variable)
1460        DO i = 0, nd-1
1461            k = len(TRIM(var))
1462            j = len(TRIM(dirname(i)))
1463            IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
1464                ids = i
1465                idsint = dirint(ids)
1466                var = var(:k-j)
1467                EXIT
1468            ENDIF
1469        ENDDO
1470        l = idsint - 2  ! horisontal direction index - terible hack !
1471        IF ( l < 0 .OR. l > 3 ) THEN
1472           l = -1
1473        END IF
1474        IF ( ids == -1 )  THEN
1475            var = TRIM(variable)
1476        ENDIF
1477        IF ( var(1:11) == 'usm_t_wall_'  .AND.  len(TRIM(var)) >= 12 )  THEN
1478!
1479!--          wall layers
1480            READ(var(12:12), '(I1)', iostat=istat ) iwl
1481            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1482                var = var(1:10)
1483            ELSE
1484!
1485!--             wrong wall layer index
1486                RETURN
1487            ENDIF
1488        ENDIF
1489        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
1490!
1491!--          wall layers
1492            READ(var(14:14), '(I1)', iostat=istat ) iwl
1493            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1494                var = var(1:12)
1495            ELSE
1496!
1497!--             wrong window layer index
1498                RETURN
1499            ENDIF
1500        ENDIF
1501        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
1502!
1503!--          wall layers
1504            READ(var(13:13), '(I1)', iostat=istat ) iwl
1505            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1506                var = var(1:11)
1507            ELSE
1508!
1509!--             wrong green layer index
1510                RETURN
1511            ENDIF
1512        ENDIF
1513        IF ( var(1:8) == 'usm_swc_'  .AND.  len(TRIM(var)) >= 9 )  THEN
1514!
1515!--          swc layers
1516            READ(var(9:9), '(I1)', iostat=istat ) iwl
1517            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
1518                var = var(1:7)
1519            ELSE
1520!
1521!--             wrong swc layer index
1522                RETURN
1523            ENDIF
1524        ENDIF
1525
1526        IF ( mode == 'allocate' )  THEN
1527           
1528           SELECT CASE ( TRIM( var ) )
1529
1530                CASE ( 'usm_wshf' )
1531!
1532!--                 array of sensible heat flux from surfaces
1533!--                 land surfaces
1534                    IF ( l == -1 ) THEN
1535                       IF ( .NOT.  ALLOCATED(surf_usm_h%wshf_eb_av) )  THEN
1536                          ALLOCATE ( surf_usm_h%wshf_eb_av(1:surf_usm_h%ns) )
1537                          surf_usm_h%wshf_eb_av = 0.0_wp
1538                       ENDIF
1539                    ELSE
1540                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wshf_eb_av) )  THEN
1541                           ALLOCATE ( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) )
1542                           surf_usm_v(l)%wshf_eb_av = 0.0_wp
1543                       ENDIF
1544                    ENDIF
1545                   
1546                CASE ( 'usm_qsws' )
1547!
1548!--                 array of latent heat flux from surfaces
1549!--                 land surfaces
1550                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_av) )  THEN
1551                        ALLOCATE ( surf_usm_h%qsws_av(1:surf_usm_h%ns) )
1552                        surf_usm_h%qsws_av = 0.0_wp
1553                    ELSE
1554                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_av) )  THEN
1555                           ALLOCATE ( surf_usm_v(l)%qsws_av(1:surf_usm_v(l)%ns) )
1556                           surf_usm_v(l)%qsws_av = 0.0_wp
1557                       ENDIF
1558                    ENDIF
1559                   
1560                CASE ( 'usm_qsws_veg' )
1561!
1562!--                 array of latent heat flux from vegetation surfaces
1563!--                 land surfaces
1564                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_veg_av) )  THEN
1565                        ALLOCATE ( surf_usm_h%qsws_veg_av(1:surf_usm_h%ns) )
1566                        surf_usm_h%qsws_veg_av = 0.0_wp
1567                    ELSE
1568                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_veg_av) )  THEN
1569                           ALLOCATE ( surf_usm_v(l)%qsws_veg_av(1:surf_usm_v(l)%ns) )
1570                           surf_usm_v(l)%qsws_veg_av = 0.0_wp
1571                       ENDIF
1572                    ENDIF
1573                   
1574                CASE ( 'usm_qsws_liq' )
1575!
1576!--                 array of latent heat flux from surfaces with liquid
1577!--                 land surfaces
1578                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%qsws_liq_av) )  THEN
1579                        ALLOCATE ( surf_usm_h%qsws_liq_av(1:surf_usm_h%ns) )
1580                        surf_usm_h%qsws_liq_av = 0.0_wp
1581                    ELSE
1582                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%qsws_liq_av) )  THEN
1583                           ALLOCATE ( surf_usm_v(l)%qsws_liq_av(1:surf_usm_v(l)%ns) )
1584                           surf_usm_v(l)%qsws_liq_av = 0.0_wp
1585                       ENDIF
1586                    ENDIF
1587!
1588!--             Please note, the following output quantities belongs to the
1589!--             individual tile fractions - ground heat flux at wall-, window-,
1590!--             and green fraction. Aggregated ground-heat flux is treated
1591!--             accordingly in average_3d_data, sum_up_3d_data, etc..
1592                CASE ( 'usm_wghf' )
1593!
1594!--                 array of heat flux from ground (wall, roof, land)
1595                    IF ( l == -1 ) THEN
1596                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_av) )  THEN
1597                           ALLOCATE ( surf_usm_h%wghf_eb_av(1:surf_usm_h%ns) )
1598                           surf_usm_h%wghf_eb_av = 0.0_wp
1599                       ENDIF
1600                    ELSE
1601                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_av) )  THEN
1602                           ALLOCATE ( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) )
1603                           surf_usm_v(l)%wghf_eb_av = 0.0_wp
1604                       ENDIF
1605                    ENDIF
1606
1607                CASE ( 'usm_wghf_window' )
1608!
1609!--                 array of heat flux from window ground (wall, roof, land)
1610                    IF ( l == -1 ) THEN
1611                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_window_av) )  THEN
1612                           ALLOCATE ( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
1613                           surf_usm_h%wghf_eb_window_av = 0.0_wp
1614                       ENDIF
1615                    ELSE
1616                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_window_av) )  THEN
1617                           ALLOCATE ( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
1618                           surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
1619                       ENDIF
1620                    ENDIF
1621
1622                CASE ( 'usm_wghf_green' )
1623!
1624!--                 array of heat flux from green ground (wall, roof, land)
1625                    IF ( l == -1 ) THEN
1626                       IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_green_av) )  THEN
1627                           ALLOCATE ( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
1628                           surf_usm_h%wghf_eb_green_av = 0.0_wp
1629                       ENDIF
1630                    ELSE
1631                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_green_av) )  THEN
1632                           ALLOCATE ( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
1633                           surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
1634                       ENDIF
1635                    ENDIF
1636
1637                CASE ( 'usm_iwghf' )
1638!
1639!--                 array of heat flux from indoor ground (wall, roof, land)
1640                    IF ( l == -1 ) THEN
1641                       IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_av) )  THEN
1642                           ALLOCATE ( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
1643                           surf_usm_h%iwghf_eb_av = 0.0_wp
1644                       ENDIF
1645                    ELSE
1646                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_av) )  THEN
1647                           ALLOCATE ( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
1648                           surf_usm_v(l)%iwghf_eb_av = 0.0_wp
1649                       ENDIF
1650                    ENDIF
1651
1652                CASE ( 'usm_iwghf_window' )
1653!
1654!--                 array of heat flux from indoor window ground (wall, roof, land)
1655                    IF ( l == -1 ) THEN
1656                       IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_window_av) )  THEN
1657                           ALLOCATE ( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
1658                           surf_usm_h%iwghf_eb_window_av = 0.0_wp
1659                       ENDIF
1660                    ELSE
1661                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_window_av) )  THEN
1662                           ALLOCATE ( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
1663                           surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
1664                       ENDIF
1665                    ENDIF
1666
1667                CASE ( 'usm_t_surf_wall' )
1668!
1669!--                 surface temperature for surfaces
1670                    IF ( l == -1 ) THEN
1671                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_wall_av) )  THEN
1672                           ALLOCATE ( surf_usm_h%t_surf_wall_av(1:surf_usm_h%ns) )
1673                           surf_usm_h%t_surf_wall_av = 0.0_wp
1674                       ENDIF
1675                    ELSE
1676                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_wall_av) )  THEN
1677                           ALLOCATE ( surf_usm_v(l)%t_surf_wall_av(1:surf_usm_v(l)%ns) )
1678                           surf_usm_v(l)%t_surf_wall_av = 0.0_wp
1679                       ENDIF
1680                    ENDIF
1681
1682                CASE ( 'usm_t_surf_window' )
1683!
1684!--                 surface temperature for window surfaces
1685                    IF ( l == -1 ) THEN
1686                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_window_av) )  THEN
1687                           ALLOCATE ( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
1688                           surf_usm_h%t_surf_window_av = 0.0_wp
1689                       ENDIF
1690                    ELSE
1691                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_window_av) )  THEN
1692                           ALLOCATE ( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
1693                           surf_usm_v(l)%t_surf_window_av = 0.0_wp
1694                       ENDIF
1695                    ENDIF
1696                   
1697                CASE ( 'usm_t_surf_green' )
1698!
1699!--                 surface temperature for green surfaces
1700                    IF ( l == -1 ) THEN
1701                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_green_av) )  THEN
1702                           ALLOCATE ( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
1703                           surf_usm_h%t_surf_green_av = 0.0_wp
1704                       ENDIF
1705                    ELSE
1706                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_green_av) )  THEN
1707                           ALLOCATE ( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
1708                           surf_usm_v(l)%t_surf_green_av = 0.0_wp
1709                       ENDIF
1710                    ENDIF
1711               
1712                CASE ( 'usm_theta_10cm' )
1713!
1714!--                 near surface (10cm) temperature for whole surfaces
1715                    IF ( l == -1 ) THEN
1716                       IF ( .NOT.  ALLOCATED(surf_usm_h%pt_10cm_av) )  THEN
1717                           ALLOCATE ( surf_usm_h%pt_10cm_av(1:surf_usm_h%ns) )
1718                           surf_usm_h%pt_10cm_av = 0.0_wp
1719                       ENDIF
1720                    ELSE
1721                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%pt_10cm_av) )  THEN
1722                           ALLOCATE ( surf_usm_v(l)%pt_10cm_av(1:surf_usm_v(l)%ns) )
1723                           surf_usm_v(l)%pt_10cm_av = 0.0_wp
1724                       ENDIF
1725                    ENDIF
1726                 
1727                CASE ( 'usm_t_wall' )
1728!
1729!--                 wall temperature for iwl layer of walls and land
1730                    IF ( l == -1 ) THEN
1731                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_wall_av) )  THEN
1732                           ALLOCATE ( surf_usm_h%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1733                           surf_usm_h%t_wall_av = 0.0_wp
1734                       ENDIF
1735                    ELSE
1736                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_wall_av) )  THEN
1737                           ALLOCATE ( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1738                           surf_usm_v(l)%t_wall_av = 0.0_wp
1739                       ENDIF
1740                    ENDIF
1741
1742                CASE ( 'usm_t_window' )
1743!
1744!--                 window temperature for iwl layer of walls and land
1745                    IF ( l == -1 ) THEN
1746                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_window_av) )  THEN
1747                           ALLOCATE ( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1748                           surf_usm_h%t_window_av = 0.0_wp
1749                       ENDIF
1750                    ELSE
1751                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_window_av) )  THEN
1752                           ALLOCATE ( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1753                           surf_usm_v(l)%t_window_av = 0.0_wp
1754                       ENDIF
1755                    ENDIF
1756
1757                CASE ( 'usm_t_green' )
1758!
1759!--                 green temperature for iwl layer of walls and land
1760                    IF ( l == -1 ) THEN
1761                       IF ( .NOT.  ALLOCATED(surf_usm_h%t_green_av) )  THEN
1762                           ALLOCATE ( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1763                           surf_usm_h%t_green_av = 0.0_wp
1764                       ENDIF
1765                    ELSE
1766                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_green_av) )  THEN
1767                           ALLOCATE ( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1768                           surf_usm_v(l)%t_green_av = 0.0_wp
1769                       ENDIF
1770                    ENDIF
1771                CASE ( 'usm_swc' )
1772!
1773!--                 soil water content for iwl layer of walls and land
1774                    IF ( l == -1 .AND. .NOT.  ALLOCATED(surf_usm_h%swc_av) )  THEN
1775                        ALLOCATE ( surf_usm_h%swc_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1776                        surf_usm_h%swc_av = 0.0_wp
1777                    ELSE
1778                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%swc_av) )  THEN
1779                           ALLOCATE ( surf_usm_v(l)%swc_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1780                           surf_usm_v(l)%swc_av = 0.0_wp
1781                       ENDIF
1782                    ENDIF
1783
1784               CASE DEFAULT
1785                   CONTINUE
1786
1787           END SELECT
1788
1789        ELSEIF ( mode == 'sum' )  THEN
1790           
1791           SELECT CASE ( TRIM( var ) )
1792
1793                CASE ( 'usm_wshf' )
1794!
1795!--                 array of sensible heat flux from surfaces (land, roof, wall)
1796                    IF ( l == -1 ) THEN
1797                       DO  m = 1, surf_usm_h%ns
1798                          surf_usm_h%wshf_eb_av(m) =                              &
1799                                             surf_usm_h%wshf_eb_av(m) +           &
1800                                             surf_usm_h%wshf_eb(m)
1801                       ENDDO
1802                    ELSE
1803                       DO  m = 1, surf_usm_v(l)%ns
1804                          surf_usm_v(l)%wshf_eb_av(m) =                        &
1805                                          surf_usm_v(l)%wshf_eb_av(m) +        &
1806                                          surf_usm_v(l)%wshf_eb(m)
1807                       ENDDO
1808                    ENDIF
1809                   
1810                CASE ( 'usm_qsws' )
1811!
1812!--                 array of latent heat flux from surfaces (land, roof, wall)
1813                    IF ( l == -1 ) THEN
1814                    DO  m = 1, surf_usm_h%ns
1815                       surf_usm_h%qsws_av(m) =                              &
1816                                          surf_usm_h%qsws_av(m) +           &
1817                                          surf_usm_h%qsws(m) * l_v
1818                    ENDDO
1819                    ELSE
1820                       DO  m = 1, surf_usm_v(l)%ns
1821                          surf_usm_v(l)%qsws_av(m) =                        &
1822                                          surf_usm_v(l)%qsws_av(m) +        &
1823                                          surf_usm_v(l)%qsws(m) * l_v
1824                       ENDDO
1825                    ENDIF
1826                   
1827                CASE ( 'usm_qsws_veg' )
1828!
1829!--                 array of latent heat flux from vegetation surfaces (land, roof, wall)
1830                    IF ( l == -1 ) THEN
1831                    DO  m = 1, surf_usm_h%ns
1832                       surf_usm_h%qsws_veg_av(m) =                              &
1833                                          surf_usm_h%qsws_veg_av(m) +           &
1834                                          surf_usm_h%qsws_veg(m)
1835                    ENDDO
1836                    ELSE
1837                       DO  m = 1, surf_usm_v(l)%ns
1838                          surf_usm_v(l)%qsws_veg_av(m) =                        &
1839                                          surf_usm_v(l)%qsws_veg_av(m) +        &
1840                                          surf_usm_v(l)%qsws_veg(m)
1841                       ENDDO
1842                    ENDIF
1843                   
1844                CASE ( 'usm_qsws_liq' )
1845!
1846!--                 array of latent heat flux from surfaces with liquid (land, roof, wall)
1847                    IF ( l == -1 ) THEN
1848                    DO  m = 1, surf_usm_h%ns
1849                       surf_usm_h%qsws_liq_av(m) =                              &
1850                                          surf_usm_h%qsws_liq_av(m) +           &
1851                                          surf_usm_h%qsws_liq(m)
1852                    ENDDO
1853                    ELSE
1854                       DO  m = 1, surf_usm_v(l)%ns
1855                          surf_usm_v(l)%qsws_liq_av(m) =                        &
1856                                          surf_usm_v(l)%qsws_liq_av(m) +        &
1857                                          surf_usm_v(l)%qsws_liq(m)
1858                       ENDDO
1859                    ENDIF
1860                   
1861                CASE ( 'usm_wghf' )
1862!
1863!--                 array of heat flux from ground (wall, roof, land)
1864                    IF ( l == -1 ) THEN
1865                       DO  m = 1, surf_usm_h%ns
1866                          surf_usm_h%wghf_eb_av(m) =                              &
1867                                             surf_usm_h%wghf_eb_av(m) +           &
1868                                             surf_usm_h%wghf_eb(m)
1869                       ENDDO
1870                    ELSE
1871                       DO  m = 1, surf_usm_v(l)%ns
1872                          surf_usm_v(l)%wghf_eb_av(m) =                        &
1873                                          surf_usm_v(l)%wghf_eb_av(m) +        &
1874                                          surf_usm_v(l)%wghf_eb(m)
1875                       ENDDO
1876                    ENDIF
1877                   
1878                CASE ( 'usm_wghf_window' )
1879!
1880!--                 array of heat flux from window ground (wall, roof, land)
1881                    IF ( l == -1 ) THEN
1882                       DO  m = 1, surf_usm_h%ns
1883                          surf_usm_h%wghf_eb_window_av(m) =                              &
1884                                             surf_usm_h%wghf_eb_window_av(m) +           &
1885                                             surf_usm_h%wghf_eb_window(m)
1886                       ENDDO
1887                    ELSE
1888                       DO  m = 1, surf_usm_v(l)%ns
1889                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
1890                                          surf_usm_v(l)%wghf_eb_window_av(m) +        &
1891                                          surf_usm_v(l)%wghf_eb_window(m)
1892                       ENDDO
1893                    ENDIF
1894
1895                CASE ( 'usm_wghf_green' )
1896!
1897!--                 array of heat flux from green ground (wall, roof, land)
1898                    IF ( l == -1 ) THEN
1899                       DO  m = 1, surf_usm_h%ns
1900                          surf_usm_h%wghf_eb_green_av(m) =                              &
1901                                             surf_usm_h%wghf_eb_green_av(m) +           &
1902                                             surf_usm_h%wghf_eb_green(m)
1903                       ENDDO
1904                    ELSE
1905                       DO  m = 1, surf_usm_v(l)%ns
1906                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
1907                                          surf_usm_v(l)%wghf_eb_green_av(m) +        &
1908                                          surf_usm_v(l)%wghf_eb_green(m)
1909                       ENDDO
1910                    ENDIF
1911                   
1912                CASE ( 'usm_iwghf' )
1913!
1914!--                 array of heat flux from indoor ground (wall, roof, land)
1915                    IF ( l == -1 ) THEN
1916                       DO  m = 1, surf_usm_h%ns
1917                          surf_usm_h%iwghf_eb_av(m) =                              &
1918                                             surf_usm_h%iwghf_eb_av(m) +           &
1919                                             surf_usm_h%iwghf_eb(m)
1920                       ENDDO
1921                    ELSE
1922                       DO  m = 1, surf_usm_v(l)%ns
1923                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
1924                                          surf_usm_v(l)%iwghf_eb_av(m) +        &
1925                                          surf_usm_v(l)%iwghf_eb(m)
1926                       ENDDO
1927                    ENDIF
1928                   
1929                CASE ( 'usm_iwghf_window' )
1930!
1931!--                 array of heat flux from indoor window ground (wall, roof, land)
1932                    IF ( l == -1 ) THEN
1933                       DO  m = 1, surf_usm_h%ns
1934                          surf_usm_h%iwghf_eb_window_av(m) =                              &
1935                                             surf_usm_h%iwghf_eb_window_av(m) +           &
1936                                             surf_usm_h%iwghf_eb_window(m)
1937                       ENDDO
1938                    ELSE
1939                       DO  m = 1, surf_usm_v(l)%ns
1940                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
1941                                          surf_usm_v(l)%iwghf_eb_window_av(m) +        &
1942                                          surf_usm_v(l)%iwghf_eb_window(m)
1943                       ENDDO
1944                    ENDIF
1945                   
1946                CASE ( 'usm_t_surf_wall' )
1947!
1948!--                 surface temperature for surfaces
1949                    IF ( l == -1 ) THEN
1950                       DO  m = 1, surf_usm_h%ns
1951                       surf_usm_h%t_surf_wall_av(m) =                               & 
1952                                          surf_usm_h%t_surf_wall_av(m) +            &
1953                                          t_surf_wall_h(m)
1954                       ENDDO
1955                    ELSE
1956                       DO  m = 1, surf_usm_v(l)%ns
1957                          surf_usm_v(l)%t_surf_wall_av(m) =                         &
1958                                          surf_usm_v(l)%t_surf_wall_av(m) +         &
1959                                          t_surf_wall_v(l)%t(m)
1960                       ENDDO
1961                    ENDIF
1962                   
1963                CASE ( 'usm_t_surf_window' )
1964!
1965!--                 surface temperature for window surfaces
1966                    IF ( l == -1 ) THEN
1967                       DO  m = 1, surf_usm_h%ns
1968                          surf_usm_h%t_surf_window_av(m) =                               &
1969                                             surf_usm_h%t_surf_window_av(m) +            &
1970                                             t_surf_window_h(m)
1971                       ENDDO
1972                    ELSE
1973                       DO  m = 1, surf_usm_v(l)%ns
1974                          surf_usm_v(l)%t_surf_window_av(m) =                         &
1975                                          surf_usm_v(l)%t_surf_window_av(m) +         &
1976                                          t_surf_window_v(l)%t(m)
1977                       ENDDO
1978                    ENDIF
1979                   
1980                CASE ( 'usm_t_surf_green' )
1981!
1982!--                 surface temperature for green surfaces
1983                    IF ( l == -1 ) THEN
1984                       DO  m = 1, surf_usm_h%ns
1985                          surf_usm_h%t_surf_green_av(m) =                               &
1986                                             surf_usm_h%t_surf_green_av(m) +            &
1987                                             t_surf_green_h(m)
1988                       ENDDO
1989                    ELSE
1990                       DO  m = 1, surf_usm_v(l)%ns
1991                          surf_usm_v(l)%t_surf_green_av(m) =                         &
1992                                          surf_usm_v(l)%t_surf_green_av(m) +         &
1993                                          t_surf_green_v(l)%t(m)
1994                       ENDDO
1995                    ENDIF
1996               
1997                CASE ( 'usm_theta_10cm' )
1998!
1999!--                 near surface temperature for whole surfaces
2000                    IF ( l == -1 ) THEN
2001                       DO  m = 1, surf_usm_h%ns
2002                          surf_usm_h%pt_10cm_av(m) =                               &
2003                                             surf_usm_h%pt_10cm_av(m) +            &
2004                                             surf_usm_h%pt_10cm(m)
2005                       ENDDO
2006                    ELSE
2007                       DO  m = 1, surf_usm_v(l)%ns
2008                          surf_usm_v(l)%pt_10cm_av(m) =                         &
2009                                          surf_usm_v(l)%pt_10cm_av(m) +         &
2010                                          surf_usm_v(l)%pt_10cm(m)
2011                       ENDDO
2012                    ENDIF
2013                   
2014                CASE ( 'usm_t_wall' )
2015!
2016!--                 wall temperature for  iwl layer of walls and land
2017                    IF ( l == -1 ) THEN
2018                       DO  m = 1, surf_usm_h%ns
2019                          surf_usm_h%t_wall_av(iwl,m) =                           &
2020                                             surf_usm_h%t_wall_av(iwl,m) +        &
2021                                             t_wall_h(iwl,m)
2022                       ENDDO
2023                    ELSE
2024                       DO  m = 1, surf_usm_v(l)%ns
2025                          surf_usm_v(l)%t_wall_av(iwl,m) =                     &
2026                                          surf_usm_v(l)%t_wall_av(iwl,m) +     &
2027                                          t_wall_v(l)%t(iwl,m)
2028                       ENDDO
2029                    ENDIF
2030                   
2031                CASE ( 'usm_t_window' )
2032!
2033!--                 window temperature for  iwl layer of walls and land
2034                    IF ( l == -1 ) THEN
2035                       DO  m = 1, surf_usm_h%ns
2036                          surf_usm_h%t_window_av(iwl,m) =                           &
2037                                             surf_usm_h%t_window_av(iwl,m) +        &
2038                                             t_window_h(iwl,m)
2039                       ENDDO
2040                    ELSE
2041                       DO  m = 1, surf_usm_v(l)%ns
2042                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
2043                                          surf_usm_v(l)%t_window_av(iwl,m) +     &
2044                                          t_window_v(l)%t(iwl,m)
2045                       ENDDO
2046                    ENDIF
2047
2048                CASE ( 'usm_t_green' )
2049!
2050!--                 green temperature for  iwl layer of walls and land
2051                    IF ( l == -1 ) THEN
2052                       DO  m = 1, surf_usm_h%ns
2053                          surf_usm_h%t_green_av(iwl,m) =                           &
2054                                             surf_usm_h%t_green_av(iwl,m) +        &
2055                                             t_green_h(iwl,m)
2056                       ENDDO
2057                    ELSE
2058                       DO  m = 1, surf_usm_v(l)%ns
2059                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
2060                                          surf_usm_v(l)%t_green_av(iwl,m) +     &
2061                                          t_green_v(l)%t(iwl,m)
2062                       ENDDO
2063                    ENDIF
2064
2065                CASE ( 'usm_swc' )
2066!
2067!--                 soil water content for  iwl layer of walls and land
2068                    IF ( l == -1 ) THEN
2069                    DO  m = 1, surf_usm_h%ns
2070                       surf_usm_h%swc_av(iwl,m) =                           &
2071                                          surf_usm_h%swc_av(iwl,m) +        &
2072                                          swc_h(iwl,m)
2073                    ENDDO
2074                    ELSE
2075                       DO  m = 1, surf_usm_v(l)%ns
2076                          surf_usm_v(l)%swc_av(iwl,m) =                     &
2077                                          surf_usm_v(l)%swc_av(iwl,m) +     &
2078                                          swc_v(l)%t(iwl,m)
2079                       ENDDO
2080                    ENDIF
2081
2082                CASE DEFAULT
2083                    CONTINUE
2084
2085           END SELECT
2086
2087        ELSEIF ( mode == 'average' )  THEN
2088           
2089           SELECT CASE ( TRIM( var ) )
2090
2091                CASE ( 'usm_wshf' )
2092!
2093!--                 array of sensible heat flux from surfaces (land, roof, wall)
2094                    IF ( l == -1 ) THEN
2095                       DO  m = 1, surf_usm_h%ns
2096                          surf_usm_h%wshf_eb_av(m) =                              &
2097                                             surf_usm_h%wshf_eb_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)%wshf_eb_av(m) =                        &
2103                                          surf_usm_v(l)%wshf_eb_av(m) /        &
2104                                          REAL( average_count_3d, kind=wp )
2105                       ENDDO
2106                    ENDIF
2107                   
2108                CASE ( 'usm_qsws' )
2109!
2110!--                 array of latent heat flux from surfaces (land, roof, wall)
2111                    IF ( l == -1 ) THEN
2112                    DO  m = 1, surf_usm_h%ns
2113                       surf_usm_h%qsws_av(m) =                              &
2114                                          surf_usm_h%qsws_av(m) /           &
2115                                          REAL( average_count_3d, kind=wp )
2116                    ENDDO
2117                    ELSE
2118                       DO  m = 1, surf_usm_v(l)%ns
2119                          surf_usm_v(l)%qsws_av(m) =                        &
2120                                          surf_usm_v(l)%qsws_av(m) /        &
2121                                          REAL( average_count_3d, kind=wp )
2122                       ENDDO
2123                    ENDIF
2124
2125                CASE ( 'usm_qsws_veg' )
2126!
2127!--                 array of latent heat flux from vegetation surfaces (land, roof, wall)
2128                    IF ( l == -1 ) THEN
2129                    DO  m = 1, surf_usm_h%ns
2130                       surf_usm_h%qsws_veg_av(m) =                              &
2131                                          surf_usm_h%qsws_veg_av(m) /           &
2132                                          REAL( average_count_3d, kind=wp )
2133                    ENDDO
2134                    ELSE
2135                       DO  m = 1, surf_usm_v(l)%ns
2136                          surf_usm_v(l)%qsws_veg_av(m) =                        &
2137                                          surf_usm_v(l)%qsws_veg_av(m) /        &
2138                                          REAL( average_count_3d, kind=wp )
2139                       ENDDO
2140                    ENDIF
2141                   
2142                CASE ( 'usm_qsws_liq' )
2143!
2144!--                 array of latent heat flux from surfaces with liquid (land, roof, wall)
2145                    IF ( l == -1 ) THEN
2146                    DO  m = 1, surf_usm_h%ns
2147                       surf_usm_h%qsws_liq_av(m) =                              &
2148                                          surf_usm_h%qsws_liq_av(m) /           &
2149                                          REAL( average_count_3d, kind=wp )
2150                    ENDDO
2151                    ELSE
2152                       DO  m = 1, surf_usm_v(l)%ns
2153                          surf_usm_v(l)%qsws_liq_av(m) =                        &
2154                                          surf_usm_v(l)%qsws_liq_av(m) /        &
2155                                          REAL( average_count_3d, kind=wp )
2156                       ENDDO
2157                    ENDIF
2158                   
2159                CASE ( 'usm_wghf' )
2160!
2161!--                 array of heat flux from ground (wall, roof, land)
2162                    IF ( l == -1 ) THEN
2163                       DO  m = 1, surf_usm_h%ns
2164                          surf_usm_h%wghf_eb_av(m) =                              &
2165                                             surf_usm_h%wghf_eb_av(m) /           &
2166                                             REAL( average_count_3d, kind=wp )
2167                       ENDDO
2168                    ELSE
2169                       DO  m = 1, surf_usm_v(l)%ns
2170                          surf_usm_v(l)%wghf_eb_av(m) =                        &
2171                                          surf_usm_v(l)%wghf_eb_av(m) /        &
2172                                          REAL( average_count_3d, kind=wp )
2173                       ENDDO
2174                    ENDIF
2175                   
2176                CASE ( 'usm_wghf_window' )
2177!
2178!--                 array of heat flux from window ground (wall, roof, land)
2179                    IF ( l == -1 ) THEN
2180                       DO  m = 1, surf_usm_h%ns
2181                          surf_usm_h%wghf_eb_window_av(m) =                              &
2182                                             surf_usm_h%wghf_eb_window_av(m) /           &
2183                                             REAL( average_count_3d, kind=wp )
2184                       ENDDO
2185                    ELSE
2186                       DO  m = 1, surf_usm_v(l)%ns
2187                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
2188                                          surf_usm_v(l)%wghf_eb_window_av(m) /        &
2189                                          REAL( average_count_3d, kind=wp )
2190                       ENDDO
2191                    ENDIF
2192
2193                CASE ( 'usm_wghf_green' )
2194!
2195!--                 array of heat flux from green ground (wall, roof, land)
2196                    IF ( l == -1 ) THEN
2197                       DO  m = 1, surf_usm_h%ns
2198                          surf_usm_h%wghf_eb_green_av(m) =                              &
2199                                             surf_usm_h%wghf_eb_green_av(m) /           &
2200                                             REAL( average_count_3d, kind=wp )
2201                       ENDDO
2202                    ELSE
2203                       DO  m = 1, surf_usm_v(l)%ns
2204                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
2205                                          surf_usm_v(l)%wghf_eb_green_av(m) /        &
2206                                          REAL( average_count_3d, kind=wp )
2207                       ENDDO
2208                    ENDIF
2209
2210                CASE ( 'usm_iwghf' )
2211!
2212!--                 array of heat flux from indoor ground (wall, roof, land)
2213                    IF ( l == -1 ) THEN
2214                       DO  m = 1, surf_usm_h%ns
2215                          surf_usm_h%iwghf_eb_av(m) =                              &
2216                                             surf_usm_h%iwghf_eb_av(m) /           &
2217                                             REAL( average_count_3d, kind=wp )
2218                       ENDDO
2219                    ELSE
2220                       DO  m = 1, surf_usm_v(l)%ns
2221                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
2222                                          surf_usm_v(l)%iwghf_eb_av(m) /        &
2223                                          REAL( average_count_3d, kind=wp )
2224                       ENDDO
2225                    ENDIF
2226                   
2227                CASE ( 'usm_iwghf_window' )
2228!
2229!--                 array of heat flux from indoor window ground (wall, roof, land)
2230                    IF ( l == -1 ) THEN
2231                       DO  m = 1, surf_usm_h%ns
2232                          surf_usm_h%iwghf_eb_window_av(m) =                              &
2233                                             surf_usm_h%iwghf_eb_window_av(m) /           &
2234                                             REAL( average_count_3d, kind=wp )
2235                       ENDDO
2236                    ELSE
2237                       DO  m = 1, surf_usm_v(l)%ns
2238                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
2239                                          surf_usm_v(l)%iwghf_eb_window_av(m) /        &
2240                                          REAL( average_count_3d, kind=wp )
2241                       ENDDO
2242                    ENDIF
2243                   
2244                CASE ( 'usm_t_surf_wall' )
2245!
2246!--                 surface temperature for surfaces
2247                    IF ( l == -1 ) THEN
2248                       DO  m = 1, surf_usm_h%ns
2249                       surf_usm_h%t_surf_wall_av(m) =                               & 
2250                                          surf_usm_h%t_surf_wall_av(m) /            &
2251                                             REAL( average_count_3d, kind=wp )
2252                       ENDDO
2253                    ELSE
2254                       DO  m = 1, surf_usm_v(l)%ns
2255                          surf_usm_v(l)%t_surf_wall_av(m) =                         &
2256                                          surf_usm_v(l)%t_surf_wall_av(m) /         &
2257                                          REAL( average_count_3d, kind=wp )
2258                       ENDDO
2259                    ENDIF
2260                   
2261                CASE ( 'usm_t_surf_window' )
2262!
2263!--                 surface temperature for window surfaces
2264                    IF ( l == -1 ) THEN
2265                       DO  m = 1, surf_usm_h%ns
2266                          surf_usm_h%t_surf_window_av(m) =                               &
2267                                             surf_usm_h%t_surf_window_av(m) /            &
2268                                             REAL( average_count_3d, kind=wp )
2269                       ENDDO
2270                    ELSE
2271                       DO  m = 1, surf_usm_v(l)%ns
2272                          surf_usm_v(l)%t_surf_window_av(m) =                         &
2273                                          surf_usm_v(l)%t_surf_window_av(m) /         &
2274                                          REAL( average_count_3d, kind=wp )
2275                       ENDDO
2276                    ENDIF
2277                   
2278                CASE ( 'usm_t_surf_green' )
2279!
2280!--                 surface temperature for green surfaces
2281                    IF ( l == -1 ) THEN
2282                       DO  m = 1, surf_usm_h%ns
2283                          surf_usm_h%t_surf_green_av(m) =                               &
2284                                             surf_usm_h%t_surf_green_av(m) /            &
2285                                             REAL( average_count_3d, kind=wp )
2286                       ENDDO
2287                    ELSE
2288                       DO  m = 1, surf_usm_v(l)%ns
2289                          surf_usm_v(l)%t_surf_green_av(m) =                         &
2290                                          surf_usm_v(l)%t_surf_green_av(m) /         &
2291                                          REAL( average_count_3d, kind=wp )
2292                       ENDDO
2293                    ENDIF
2294                   
2295                CASE ( 'usm_theta_10cm' )
2296!
2297!--                 near surface temperature for whole surfaces
2298                    IF ( l == -1 ) THEN
2299                       DO  m = 1, surf_usm_h%ns
2300                          surf_usm_h%pt_10cm_av(m) =                               &
2301                                             surf_usm_h%pt_10cm_av(m) /            &
2302                                             REAL( average_count_3d, kind=wp )
2303                       ENDDO
2304                    ELSE
2305                       DO  m = 1, surf_usm_v(l)%ns
2306                          surf_usm_v(l)%pt_10cm_av(m) =                         &
2307                                          surf_usm_v(l)%pt_10cm_av(m) /         &
2308                                          REAL( average_count_3d, kind=wp )
2309                       ENDDO
2310                    ENDIF
2311
2312                   
2313                CASE ( 'usm_t_wall' )
2314!
2315!--                 wall temperature for  iwl layer of walls and land
2316                    IF ( l == -1 ) THEN
2317                       DO  m = 1, surf_usm_h%ns
2318                          surf_usm_h%t_wall_av(iwl,m) =                           &
2319                                             surf_usm_h%t_wall_av(iwl,m) /        &
2320                                             REAL( average_count_3d, kind=wp )
2321                       ENDDO
2322                    ELSE
2323                       DO  m = 1, surf_usm_v(l)%ns
2324                          surf_usm_v(l)%t_wall_av(iwl,m) =                     &
2325                                          surf_usm_v(l)%t_wall_av(iwl,m) /     &
2326                                          REAL( average_count_3d, kind=wp )
2327                       ENDDO
2328                    ENDIF
2329
2330                CASE ( 'usm_t_window' )
2331!
2332!--                 window temperature for  iwl layer of walls and land
2333                    IF ( l == -1 ) THEN
2334                       DO  m = 1, surf_usm_h%ns
2335                          surf_usm_h%t_window_av(iwl,m) =                           &
2336                                             surf_usm_h%t_window_av(iwl,m) /        &
2337                                             REAL( average_count_3d, kind=wp )
2338                       ENDDO
2339                    ELSE
2340                       DO  m = 1, surf_usm_v(l)%ns
2341                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
2342                                          surf_usm_v(l)%t_window_av(iwl,m) /     &
2343                                          REAL( average_count_3d, kind=wp )
2344                       ENDDO
2345                    ENDIF
2346
2347                CASE ( 'usm_t_green' )
2348!
2349!--                 green temperature for  iwl layer of walls and land
2350                    IF ( l == -1 ) THEN
2351                       DO  m = 1, surf_usm_h%ns
2352                          surf_usm_h%t_green_av(iwl,m) =                           &
2353                                             surf_usm_h%t_green_av(iwl,m) /        &
2354                                             REAL( average_count_3d, kind=wp )
2355                       ENDDO
2356                    ELSE
2357                       DO  m = 1, surf_usm_v(l)%ns
2358                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
2359                                          surf_usm_v(l)%t_green_av(iwl,m) /     &
2360                                          REAL( average_count_3d, kind=wp )
2361                       ENDDO
2362                    ENDIF
2363                   
2364                CASE ( 'usm_swc' )
2365!
2366!--                 soil water content for  iwl layer of walls and land
2367                    IF ( l == -1 ) THEN
2368                    DO  m = 1, surf_usm_h%ns
2369                       surf_usm_h%swc_av(iwl,m) =                           &
2370                                          surf_usm_h%swc_av(iwl,m) /        &
2371                                          REAL( average_count_3d, kind=wp )
2372                    ENDDO
2373                    ELSE
2374                       DO  m = 1, surf_usm_v(l)%ns
2375                          surf_usm_v(l)%swc_av(iwl,m) =                     &
2376                                          surf_usm_v(l)%swc_av(iwl,m) /     &
2377                                          REAL( average_count_3d, kind=wp )
2378                       ENDDO
2379                    ENDIF
2380
2381
2382           END SELECT
2383
2384        ENDIF
2385
2386        ENDIF
2387
2388    END SUBROUTINE usm_3d_data_averaging
2389
2390
2391
2392!------------------------------------------------------------------------------!
2393! Description:
2394! ------------
2395!> Set internal Neumann boundary condition at outer soil grid points
2396!> for temperature and humidity.
2397!------------------------------------------------------------------------------!
2398 SUBROUTINE usm_boundary_condition
2399 
2400    IMPLICIT NONE
2401
2402    INTEGER(iwp) :: i      !< grid index x-direction
2403    INTEGER(iwp) :: ioff   !< offset index x-direction indicating location of soil grid point
2404    INTEGER(iwp) :: j      !< grid index y-direction
2405    INTEGER(iwp) :: joff   !< offset index x-direction indicating location of soil grid point
2406    INTEGER(iwp) :: k      !< grid index z-direction
2407    INTEGER(iwp) :: koff   !< offset index x-direction indicating location of soil grid point
2408    INTEGER(iwp) :: l      !< running index surface-orientation
2409    INTEGER(iwp) :: m      !< running index surface elements
2410
2411    koff = surf_usm_h%koff
2412    DO  m = 1, surf_usm_h%ns
2413       i = surf_usm_h%i(m)
2414       j = surf_usm_h%j(m)
2415       k = surf_usm_h%k(m)
2416       pt(k+koff,j,i) = pt(k,j,i)
2417    ENDDO
2418
2419    DO  l = 0, 3
2420       ioff = surf_usm_v(l)%ioff
2421       joff = surf_usm_v(l)%joff
2422       DO  m = 1, surf_usm_v(l)%ns
2423          i = surf_usm_v(l)%i(m)
2424          j = surf_usm_v(l)%j(m)
2425          k = surf_usm_v(l)%k(m)
2426          pt(k,j+joff,i+ioff) = pt(k,j,i)
2427       ENDDO
2428    ENDDO
2429
2430 END SUBROUTINE usm_boundary_condition
2431
2432
2433!------------------------------------------------------------------------------!
2434!
2435! Description:
2436! ------------
2437!> Subroutine checks variables and assigns units.
2438!> It is called out from subroutine check_parameters.
2439!------------------------------------------------------------------------------!
2440    SUBROUTINE usm_check_data_output( variable, unit )
2441
2442        IMPLICIT NONE
2443
2444        CHARACTER(LEN=*),INTENT(IN)    ::  variable   !<
2445        CHARACTER(LEN=*),INTENT(OUT)   ::  unit       !<
2446
2447        INTEGER(iwp)                                  :: i,j,l         !< index
2448        CHARACTER(LEN=2)                              :: ls
2449        CHARACTER(LEN=varnamelength)                  :: var           !< TRIM(variable)
2450        INTEGER(iwp), PARAMETER                       :: nl1 = 15      !< number of directional usm variables
2451        CHARACTER(LEN=varnamelength), DIMENSION(nl1)  :: varlist1 = &  !< list of directional usm variables
2452                  (/'usm_wshf                      ', &
2453                    'usm_wghf                      ', &
2454                    'usm_wghf_window               ', &
2455                    'usm_wghf_green                ', &
2456                    'usm_iwghf                     ', &
2457                    'usm_iwghf_window              ', &
2458                    'usm_surfz                     ', &
2459                    'usm_surfwintrans              ', &
2460                    'usm_surfcat                   ', &
2461                    'usm_t_surf_wall               ', &
2462                    'usm_t_surf_window             ', &
2463                    'usm_t_surf_green              ', &
2464                    'usm_t_green                   ', &
2465                    'usm_qsws                      ', &
2466                    'usm_theta_10cm                '/)
2467
2468        INTEGER(iwp), PARAMETER                       :: nl2 = 3       !< number of directional layer usm variables
2469        CHARACTER(LEN=varnamelength), DIMENSION(nl2)  :: varlist2 = &  !< list of directional layer usm variables
2470                  (/'usm_t_wall                    ', &
2471                    'usm_t_window                  ', &
2472                    'usm_t_green                   '/)
2473
2474        INTEGER(iwp), PARAMETER                       :: nd = 5     !< number of directions
2475        CHARACTER(LEN=6), DIMENSION(nd), PARAMETER  :: dirname = &  !< direction names
2476                  (/'_roof ','_south','_north','_west ','_east '/)
2477        LOGICAL                                       :: lfound     !< flag if the variable is found
2478
2479
2480        lfound = .FALSE.
2481
2482        var = TRIM(variable)
2483
2484!
2485!--     check if variable exists
2486!--     directional variables
2487        DO i = 1, nl1
2488           DO j = 1, nd
2489              IF ( TRIM(var) == TRIM(varlist1(i))//TRIM(dirname(j)) ) THEN
2490                 lfound = .TRUE.
2491                 EXIT
2492              ENDIF
2493              IF ( lfound ) EXIT
2494           ENDDO
2495        ENDDO
2496        IF ( lfound ) GOTO 10
2497!
2498!--     directional layer variables
2499        DO i = 1, nl2
2500           DO j = 1, nd
2501              DO l = nzb_wall, nzt_wall
2502                 WRITE(ls,'(A1,I1)') '_',l
2503                 IF ( TRIM(var) == TRIM(varlist2(i))//TRIM(ls)//TRIM(dirname(j)) ) THEN
2504                    lfound = .TRUE.
2505                    EXIT
2506                 ENDIF
2507              ENDDO
2508              IF ( lfound ) EXIT
2509           ENDDO
2510        ENDDO
2511        IF ( .NOT.  lfound ) THEN
2512           unit = 'illegal'
2513           RETURN
2514        ENDIF
251510      CONTINUE
2516
2517        IF ( var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' .OR.                 &
2518             var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR.     &
2519             var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_'    .OR.      &
2520             var(1:17) == 'usm_surfwintrans_' .OR.                                        &
2521             var(1:9)  == 'usm_qsws_'  .OR.  var(1:13)  == 'usm_qsws_veg_'  .OR.          &
2522             var(1:13) == 'usm_qsws_liq_' ) THEN
2523            unit = 'W/m2'
2524        ELSE IF ( var(1:15) == 'usm_t_surf_wall'   .OR.  var(1:10) == 'usm_t_wall' .OR.   &
2525                  var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR.  &
2526                  var(1:16) == 'usm_t_surf_green'  .OR.                                   &
2527                  var(1:11) == 'usm_t_green' .OR.  var(1:7) == 'usm_swc' .OR.             &
2528                  var(1:14) == 'usm_theta_10cm' )  THEN
2529            unit = 'K'
2530        ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat' )  THEN
2531            unit = '1'
2532        ELSE
2533            unit = 'illegal'
2534        ENDIF
2535
2536    END SUBROUTINE usm_check_data_output
2537
2538
2539!------------------------------------------------------------------------------!
2540! Description:
2541! ------------
2542!> Check parameters routine for urban surface model
2543!------------------------------------------------------------------------------!
2544    SUBROUTINE usm_check_parameters
2545
2546       USE control_parameters,                                                 &
2547           ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, large_scale_forcing,   &
2548                  lsf_surf, topography
2549
2550       USE netcdf_data_input_mod,                                             &
2551            ONLY:  building_type_f
2552
2553       IMPLICIT NONE
2554
2555       INTEGER(iwp) ::  i        !< running index, x-dimension
2556       INTEGER(iwp) ::  j        !< running index, y-dimension
2557
2558!
2559!--    Dirichlet boundary conditions are required as the surface fluxes are
2560!--    calculated from the temperature/humidity gradients in the urban surface
2561!--    model
2562       IF ( bc_pt_b == 'neumann'   .OR.   bc_q_b == 'neumann' )  THEN
2563          message_string = 'urban surface model requires setting of '//        &
2564                           'bc_pt_b = "dirichlet" and '//                      &
2565                           'bc_q_b  = "dirichlet"'
2566          CALL message( 'usm_check_parameters', 'PA0590', 1, 2, 0, 6, 0 )
2567       ENDIF
2568
2569       IF ( .NOT.  constant_flux_layer )  THEN
2570          message_string = 'urban surface model requires '//                   &
2571                           'constant_flux_layer = .T.'
2572          CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2573       ENDIF
2574
2575       IF (  .NOT.  radiation )  THEN
2576          message_string = 'urban surface model requires '//                   &
2577                           'the radiation model to be switched on'
2578          CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2579       ENDIF
2580!       
2581!--    Surface forcing has to be disabled for LSF in case of enabled
2582!--    urban surface module
2583       IF ( large_scale_forcing )  THEN
2584          lsf_surf = .FALSE.
2585       ENDIF
2586!
2587!--    Topography
2588       IF ( topography == 'flat' )  THEN
2589          message_string = 'topography /= "flat" is required '//               &
2590                           'when using the urban surface model'
2591          CALL message( 'usm_check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
2592       ENDIF
2593!
2594!--    naheatlayers
2595       IF ( naheatlayers > nzt )  THEN
2596          message_string = 'number of anthropogenic heat layers '//            &
2597                           '"naheatlayers" can not be larger than'//           &
2598                           ' number of domain layers "nzt"'
2599          CALL message( 'usm_check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
2600       ENDIF
2601!
2602!--    Check if building types are set within a valid range.
2603       IF ( building_type < LBOUND( building_pars, 2 )  .AND.                  &
2604            building_type > UBOUND( building_pars, 2 ) )  THEN
2605          WRITE( message_string, * ) 'building_type = ', building_type,        &
2606                                     ' is out of the valid range'
2607          CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
2608       ENDIF
2609       IF ( building_type_f%from_file )  THEN
2610          DO  i = nxl, nxr
2611             DO  j = nys, nyn
2612                IF ( building_type_f%var(j,i) /= building_type_f%fill  .AND.   &
2613              ( building_type_f%var(j,i) < LBOUND( building_pars, 2 )  .OR.    &
2614                building_type_f%var(j,i) > UBOUND( building_pars, 2 ) ) )      &
2615                THEN
2616                   WRITE( message_string, * ) 'building_type = is out of ' //  &
2617                                        'the valid range at (j,i) = ', j, i
2618                   CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
2619                ENDIF
2620             ENDDO
2621          ENDDO
2622       ENDIF
2623    END SUBROUTINE usm_check_parameters
2624
2625
2626!------------------------------------------------------------------------------!
2627!
2628! Description:
2629! ------------
2630!> Output of the 3D-arrays in netCDF and/or AVS format
2631!> for variables of urban_surface model.
2632!> It resorts the urban surface module output quantities from surf style
2633!> indexing into temporary 3D array with indices (i,j,k).
2634!> It is called from subroutine data_output_3d.
2635!------------------------------------------------------------------------------!
2636    SUBROUTINE usm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
2637       
2638        IMPLICIT NONE
2639
2640        INTEGER(iwp), INTENT(IN)       ::  av        !< flag if averaged
2641        CHARACTER (len=*), INTENT(IN)  ::  variable  !< variable name
2642        INTEGER(iwp), INTENT(IN)       ::  nzb_do    !< lower limit of the data output (usually 0)
2643        INTEGER(iwp), INTENT(IN)       ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
2644        LOGICAL, INTENT(OUT)           ::  found     !<
2645        REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< sp - it has to correspond to module data_output_3d
2646        REAL(sp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf    !< temp array for urban surface output procedure
2647       
2648        CHARACTER (len=varnamelength)                      :: var     !< trimmed variable name
2649        INTEGER(iwp), PARAMETER                            :: nd = 5  !< number of directions
2650        CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
2651        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
2652        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: diridx =  (/       -1,        1,        0,        3,        2 /)
2653                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
2654        INTEGER(iwp)                   :: ids,idsint,idsidx
2655        INTEGER(iwp)                   :: i,j,k,iwl,istat, l, m  !< running indices
2656
2657        found = .TRUE.
2658        temp_pf = -1._wp
2659       
2660        ids = -1
2661        var = TRIM(variable)
2662        DO i = 0, nd-1
2663            k = len(TRIM(var))
2664            j = len(TRIM(dirname(i)))
2665            IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
2666                ids = i
2667                idsint = dirint(ids)
2668                idsidx = diridx(ids)
2669                var = var(:k-j)
2670                EXIT
2671            ENDIF
2672        ENDDO
2673        IF ( ids == -1 )  THEN
2674            var = TRIM(variable)
2675        ENDIF
2676        IF ( var(1:11) == 'usm_t_wall_'  .AND.  len(TRIM(var)) >= 12 )  THEN
2677!
2678!--         wall layers
2679            READ(var(12:12), '(I1)', iostat=istat ) iwl
2680            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2681                var = var(1:10)
2682            ENDIF
2683        ENDIF
2684        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
2685!
2686!--         window layers
2687            READ(var(14:14), '(I1)', iostat=istat ) iwl
2688            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2689                var = var(1:12)
2690            ENDIF
2691        ENDIF
2692        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
2693!
2694!--         green layers
2695            READ(var(13:13), '(I1)', iostat=istat ) iwl
2696            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2697                var = var(1:11)
2698            ENDIF
2699        ENDIF
2700        IF ( var(1:8) == 'usm_swc_'  .AND.  len(TRIM(var)) >= 9 )  THEN
2701!
2702!--         green layers soil water content
2703            READ(var(9:9), '(I1)', iostat=istat ) iwl
2704            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
2705                var = var(1:7)
2706            ENDIF
2707        ENDIF
2708       
2709        SELECT CASE ( TRIM(var) )
2710
2711          CASE ( 'usm_surfz' )
2712!
2713!--           array of surface height (z)
2714              IF ( idsint == iup_u )  THEN
2715                 DO  m = 1, surf_usm_h%ns
2716                    i = surf_usm_h%i(m)
2717                    j = surf_usm_h%j(m)
2718                    k = surf_usm_h%k(m)
2719                    temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) )
2720                 ENDDO
2721              ELSE
2722                 l = idsidx
2723                 DO  m = 1, surf_usm_v(l)%ns
2724                    i = surf_usm_v(l)%i(m)
2725                    j = surf_usm_v(l)%j(m)
2726                    k = surf_usm_v(l)%k(m)
2727                    temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, KIND = sp) + 1.0_sp )
2728                 ENDDO
2729              ENDIF
2730
2731          CASE ( 'usm_surfcat' )
2732!
2733!--           surface category
2734              IF ( idsint == iup_u )  THEN
2735                 DO  m = 1, surf_usm_h%ns
2736                    i = surf_usm_h%i(m)
2737                    j = surf_usm_h%j(m)
2738                    k = surf_usm_h%k(m)
2739                    temp_pf(k,j,i) = surf_usm_h%surface_types(m)
2740                 ENDDO
2741              ELSE
2742                 l = idsidx
2743                 DO  m = 1, surf_usm_v(l)%ns
2744                    i = surf_usm_v(l)%i(m)
2745                    j = surf_usm_v(l)%j(m)
2746                    k = surf_usm_v(l)%k(m)
2747                    temp_pf(k,j,i) = surf_usm_v(l)%surface_types(m)
2748                 ENDDO
2749              ENDIF
2750             
2751          CASE ( 'usm_surfwintrans' )
2752!
2753!--           transmissivity window tiles
2754              IF ( idsint == iup_u )  THEN
2755                 DO  m = 1, surf_usm_h%ns
2756                    i = surf_usm_h%i(m)
2757                    j = surf_usm_h%j(m)
2758                    k = surf_usm_h%k(m)
2759                    temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
2760                 ENDDO
2761              ELSE
2762                 l = idsidx
2763                 DO  m = 1, surf_usm_v(l)%ns
2764                    i = surf_usm_v(l)%i(m)
2765                    j = surf_usm_v(l)%j(m)
2766                    k = surf_usm_v(l)%k(m)
2767                    temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
2768                 ENDDO
2769              ENDIF
2770
2771          CASE ( 'usm_wshf' )
2772!
2773!--           array of sensible heat flux from surfaces
2774              IF ( av == 0 )  THEN
2775                 IF ( idsint == iup_u )  THEN
2776                    DO  m = 1, surf_usm_h%ns
2777                       i = surf_usm_h%i(m)
2778                       j = surf_usm_h%j(m)
2779                       k = surf_usm_h%k(m)
2780                       temp_pf(k,j,i) = surf_usm_h%wshf_eb(m)
2781                    ENDDO
2782                 ELSE
2783                    l = idsidx
2784                    DO  m = 1, surf_usm_v(l)%ns
2785                       i = surf_usm_v(l)%i(m)
2786                       j = surf_usm_v(l)%j(m)
2787                       k = surf_usm_v(l)%k(m)
2788                       temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb(m)
2789                    ENDDO
2790                 ENDIF
2791              ELSE
2792                 IF ( idsint == iup_u )  THEN
2793                    DO  m = 1, surf_usm_h%ns
2794                       i = surf_usm_h%i(m)
2795                       j = surf_usm_h%j(m)
2796                       k = surf_usm_h%k(m)
2797                       temp_pf(k,j,i) = surf_usm_h%wshf_eb_av(m)
2798                    ENDDO
2799                 ELSE
2800                    l = idsidx
2801                    DO  m = 1, surf_usm_v(l)%ns
2802                       i = surf_usm_v(l)%i(m)
2803                       j = surf_usm_v(l)%j(m)
2804                       k = surf_usm_v(l)%k(m)
2805                       temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb_av(m)
2806                    ENDDO
2807                 ENDIF
2808              ENDIF
2809             
2810             
2811          CASE ( 'usm_qsws' )
2812!
2813!--           array of latent heat flux from surfaces
2814              IF ( av == 0 )  THEN
2815                 IF ( idsint == iup_u )  THEN
2816                    DO  m = 1, surf_usm_h%ns
2817                       i = surf_usm_h%i(m)
2818                       j = surf_usm_h%j(m)
2819                       k = surf_usm_h%k(m)
2820                       temp_pf(k,j,i) = surf_usm_h%qsws(m) * l_v
2821                    ENDDO
2822                 ELSE
2823                    l = idsidx
2824                    DO  m = 1, surf_usm_v(l)%ns
2825                       i = surf_usm_v(l)%i(m)
2826                       j = surf_usm_v(l)%j(m)
2827                       k = surf_usm_v(l)%k(m)
2828                       temp_pf(k,j,i) = surf_usm_v(l)%qsws(m) * l_v
2829                    ENDDO
2830                 ENDIF
2831              ELSE
2832                 IF ( idsint == iup_u )  THEN
2833                    DO  m = 1, surf_usm_h%ns
2834                       i = surf_usm_h%i(m)
2835                       j = surf_usm_h%j(m)
2836                       k = surf_usm_h%k(m)
2837                       temp_pf(k,j,i) = surf_usm_h%qsws_av(m)
2838                    ENDDO
2839                 ELSE
2840                    l = idsidx
2841                    DO  m = 1, surf_usm_v(l)%ns
2842                       i = surf_usm_v(l)%i(m)
2843                       j = surf_usm_v(l)%j(m)
2844                       k = surf_usm_v(l)%k(m)
2845                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_av(m)
2846                    ENDDO
2847                 ENDIF
2848              ENDIF
2849             
2850          CASE ( 'usm_qsws_veg' )
2851!
2852!--           array of latent heat flux from vegetation surfaces
2853              IF ( av == 0 )  THEN
2854                 IF ( idsint == iup_u )  THEN
2855                    DO  m = 1, surf_usm_h%ns
2856                       i = surf_usm_h%i(m)
2857                       j = surf_usm_h%j(m)
2858                       k = surf_usm_h%k(m)
2859                       temp_pf(k,j,i) = surf_usm_h%qsws_veg(m)
2860                    ENDDO
2861                 ELSE
2862                    l = idsidx
2863                    DO  m = 1, surf_usm_v(l)%ns
2864                       i = surf_usm_v(l)%i(m)
2865                       j = surf_usm_v(l)%j(m)
2866                       k = surf_usm_v(l)%k(m)
2867                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg(m)
2868                    ENDDO
2869                 ENDIF
2870              ELSE
2871                 IF ( idsint == iup_u )  THEN
2872                    DO  m = 1, surf_usm_h%ns
2873                       i = surf_usm_h%i(m)
2874                       j = surf_usm_h%j(m)
2875                       k = surf_usm_h%k(m)
2876                       temp_pf(k,j,i) = surf_usm_h%qsws_veg_av(m)
2877                    ENDDO
2878                 ELSE
2879                    l = idsidx
2880                    DO  m = 1, surf_usm_v(l)%ns
2881                       i = surf_usm_v(l)%i(m)
2882                       j = surf_usm_v(l)%j(m)
2883                       k = surf_usm_v(l)%k(m)
2884                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_av(m)
2885                    ENDDO
2886                 ENDIF
2887              ENDIF
2888             
2889          CASE ( 'usm_qsws_liq' )
2890!
2891!--           array of latent heat flux from surfaces with liquid
2892              IF ( av == 0 )  THEN
2893                 IF ( idsint == iup_u )  THEN
2894                    DO  m = 1, surf_usm_h%ns
2895                       i = surf_usm_h%i(m)
2896                       j = surf_usm_h%j(m)
2897                       k = surf_usm_h%k(m)
2898                       temp_pf(k,j,i) = surf_usm_h%qsws_liq(m)
2899                    ENDDO
2900                 ELSE
2901                    l = idsidx
2902                    DO  m = 1, surf_usm_v(l)%ns
2903                       i = surf_usm_v(l)%i(m)
2904                       j = surf_usm_v(l)%j(m)
2905                       k = surf_usm_v(l)%k(m)
2906                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq(m)
2907                    ENDDO
2908                 ENDIF
2909              ELSE
2910                 IF ( idsint == iup_u )  THEN
2911                    DO  m = 1, surf_usm_h%ns
2912                       i = surf_usm_h%i(m)
2913                       j = surf_usm_h%j(m)
2914                       k = surf_usm_h%k(m)
2915                       temp_pf(k,j,i) = surf_usm_h%qsws_liq_av(m)
2916                    ENDDO
2917                 ELSE
2918                    l = idsidx
2919                    DO  m = 1, surf_usm_v(l)%ns
2920                       i = surf_usm_v(l)%i(m)
2921                       j = surf_usm_v(l)%j(m)
2922                       k = surf_usm_v(l)%k(m)
2923                       temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_av(m)
2924                    ENDDO
2925                 ENDIF
2926              ENDIF
2927
2928          CASE ( 'usm_wghf' )
2929!
2930!--           array of heat flux from ground (land, wall, roof)
2931              IF ( av == 0 )  THEN
2932                 IF ( idsint == iup_u )  THEN
2933                    DO  m = 1, surf_usm_h%ns
2934                       i = surf_usm_h%i(m)
2935                       j = surf_usm_h%j(m)
2936                       k = surf_usm_h%k(m)
2937                       temp_pf(k,j,i) = surf_usm_h%wghf_eb(m)
2938                    ENDDO
2939                 ELSE
2940                    l = idsidx
2941                    DO  m = 1, surf_usm_v(l)%ns
2942                       i = surf_usm_v(l)%i(m)
2943                       j = surf_usm_v(l)%j(m)
2944                       k = surf_usm_v(l)%k(m)
2945                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb(m)
2946                    ENDDO
2947                 ENDIF
2948              ELSE
2949                 IF ( idsint == iup_u )  THEN
2950                    DO  m = 1, surf_usm_h%ns
2951                       i = surf_usm_h%i(m)
2952                       j = surf_usm_h%j(m)
2953                       k = surf_usm_h%k(m)
2954                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_av(m)
2955                    ENDDO
2956                 ELSE
2957                    l = idsidx
2958                    DO  m = 1, surf_usm_v(l)%ns
2959                       i = surf_usm_v(l)%i(m)
2960                       j = surf_usm_v(l)%j(m)
2961                       k = surf_usm_v(l)%k(m)
2962                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_av(m)
2963                    ENDDO
2964                 ENDIF
2965              ENDIF
2966
2967          CASE ( 'usm_wghf_window' )
2968!
2969!--           array of heat flux from window ground (land, wall, roof)
2970              IF ( av == 0 )  THEN
2971                 IF ( idsint == iup_u )  THEN
2972                    DO  m = 1, surf_usm_h%ns
2973                       i = surf_usm_h%i(m)
2974                       j = surf_usm_h%j(m)
2975                       k = surf_usm_h%k(m)
2976                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
2977                    ENDDO
2978                 ELSE
2979                    l = idsidx
2980                    DO  m = 1, surf_usm_v(l)%ns
2981                       i = surf_usm_v(l)%i(m)
2982                       j = surf_usm_v(l)%j(m)
2983                       k = surf_usm_v(l)%k(m)
2984                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
2985                    ENDDO
2986                 ENDIF
2987              ELSE
2988                 IF ( idsint == iup_u )  THEN
2989                    DO  m = 1, surf_usm_h%ns
2990                       i = surf_usm_h%i(m)
2991                       j = surf_usm_h%j(m)
2992                       k = surf_usm_h%k(m)
2993                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
2994                    ENDDO
2995                 ELSE
2996                    l = idsidx
2997                    DO  m = 1, surf_usm_v(l)%ns
2998                       i = surf_usm_v(l)%i(m)
2999                       j = surf_usm_v(l)%j(m)
3000                       k = surf_usm_v(l)%k(m)
3001                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
3002                    ENDDO
3003                 ENDIF
3004              ENDIF
3005
3006          CASE ( 'usm_wghf_green' )
3007!
3008!--           array of heat flux from green ground (land, wall, roof)
3009              IF ( av == 0 )  THEN
3010                 IF ( idsint == iup_u )  THEN
3011                    DO  m = 1, surf_usm_h%ns
3012                       i = surf_usm_h%i(m)
3013                       j = surf_usm_h%j(m)
3014                       k = surf_usm_h%k(m)
3015                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
3016                    ENDDO
3017                 ELSE
3018                    l = idsidx
3019                    DO  m = 1, surf_usm_v(l)%ns
3020                       i = surf_usm_v(l)%i(m)
3021                       j = surf_usm_v(l)%j(m)
3022                       k = surf_usm_v(l)%k(m)
3023                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
3024                    ENDDO
3025                 ENDIF
3026              ELSE
3027                 IF ( idsint == iup_u )  THEN
3028                    DO  m = 1, surf_usm_h%ns
3029                       i = surf_usm_h%i(m)
3030                       j = surf_usm_h%j(m)
3031                       k = surf_usm_h%k(m)
3032                       temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
3033                    ENDDO
3034                 ELSE
3035                    l = idsidx
3036                    DO  m = 1, surf_usm_v(l)%ns
3037                       i = surf_usm_v(l)%i(m)
3038                       j = surf_usm_v(l)%j(m)
3039                       k = surf_usm_v(l)%k(m)
3040                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
3041                    ENDDO
3042                 ENDIF
3043              ENDIF
3044
3045          CASE ( 'usm_iwghf' )
3046!
3047!--           array of heat flux from indoor ground (land, wall, roof)
3048              IF ( av == 0 )  THEN
3049                 IF ( idsint == iup_u )  THEN
3050                    DO  m = 1, surf_usm_h%ns
3051                       i = surf_usm_h%i(m)
3052                       j = surf_usm_h%j(m)
3053                       k = surf_usm_h%k(m)
3054                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
3055                    ENDDO
3056                 ELSE
3057                    l = idsidx
3058                    DO  m = 1, surf_usm_v(l)%ns
3059                       i = surf_usm_v(l)%i(m)
3060                       j = surf_usm_v(l)%j(m)
3061                       k = surf_usm_v(l)%k(m)
3062                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
3063                    ENDDO
3064                 ENDIF
3065              ELSE
3066                 IF ( idsint == iup_u )  THEN
3067                    DO  m = 1, surf_usm_h%ns
3068                       i = surf_usm_h%i(m)
3069                       j = surf_usm_h%j(m)
3070                       k = surf_usm_h%k(m)
3071                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
3072                    ENDDO
3073                 ELSE
3074                    l = idsidx
3075                    DO  m = 1, surf_usm_v(l)%ns
3076                       i = surf_usm_v(l)%i(m)
3077                       j = surf_usm_v(l)%j(m)
3078                       k = surf_usm_v(l)%k(m)
3079                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
3080                    ENDDO
3081                 ENDIF
3082              ENDIF
3083
3084          CASE ( 'usm_iwghf_window' )
3085!
3086!--           array of heat flux from indoor window ground (land, wall, roof)
3087              IF ( av == 0 )  THEN
3088                 IF ( idsint == iup_u )  THEN
3089                    DO  m = 1, surf_usm_h%ns
3090                       i = surf_usm_h%i(m)
3091                       j = surf_usm_h%j(m)
3092                       k = surf_usm_h%k(m)
3093                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(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)%iwghf_eb_window(m)
3102                    ENDDO
3103                 ENDIF
3104              ELSE
3105                 IF ( idsint == iup_u )  THEN
3106                    DO  m = 1, surf_usm_h%ns
3107                       i = surf_usm_h%i(m)
3108                       j = surf_usm_h%j(m)
3109                       k = surf_usm_h%k(m)
3110                       temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
3111                    ENDDO
3112                 ELSE
3113                    l = idsidx
3114                    DO  m = 1, surf_usm_v(l)%ns
3115                       i = surf_usm_v(l)%i(m)
3116                       j = surf_usm_v(l)%j(m)
3117                       k = surf_usm_v(l)%k(m)
3118                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
3119                    ENDDO
3120                 ENDIF
3121              ENDIF
3122             
3123          CASE ( 'usm_t_surf_wall' )
3124!
3125!--           surface temperature for surfaces
3126              IF ( av == 0 )  THEN
3127                 IF ( idsint == iup_u )  THEN
3128                    DO  m = 1, surf_usm_h%ns
3129                       i = surf_usm_h%i(m)
3130                       j = surf_usm_h%j(m)
3131                       k = surf_usm_h%k(m)
3132                       temp_pf(k,j,i) = t_surf_wall_h(m)
3133                    ENDDO
3134                 ELSE
3135                    l = idsidx
3136                    DO  m = 1, surf_usm_v(l)%ns
3137                       i = surf_usm_v(l)%i(m)
3138                       j = surf_usm_v(l)%j(m)
3139                       k = surf_usm_v(l)%k(m)
3140                       temp_pf(k,j,i) = t_surf_wall_v(l)%t(m)
3141                    ENDDO
3142                 ENDIF
3143              ELSE
3144                 IF ( idsint == iup_u )  THEN
3145                    DO  m = 1, surf_usm_h%ns
3146                       i = surf_usm_h%i(m)
3147                       j = surf_usm_h%j(m)
3148                       k = surf_usm_h%k(m)
3149                       temp_pf(k,j,i) = surf_usm_h%t_surf_wall_av(m)
3150                    ENDDO
3151                 ELSE
3152                    l = idsidx
3153                    DO  m = 1, surf_usm_v(l)%ns
3154                       i = surf_usm_v(l)%i(m)
3155                       j = surf_usm_v(l)%j(m)
3156                       k = surf_usm_v(l)%k(m)
3157                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_wall_av(m)
3158                    ENDDO
3159                 ENDIF
3160              ENDIF
3161             
3162          CASE ( 'usm_t_surf_window' )
3163!
3164!--           surface temperature for window surfaces
3165              IF ( av == 0 )  THEN
3166                 IF ( idsint == iup_u )  THEN
3167                    DO  m = 1, surf_usm_h%ns
3168                       i = surf_usm_h%i(m)
3169                       j = surf_usm_h%j(m)
3170                       k = surf_usm_h%k(m)
3171                       temp_pf(k,j,i) = t_surf_window_h(m)
3172                    ENDDO
3173                 ELSE
3174                    l = idsidx
3175                    DO  m = 1, surf_usm_v(l)%ns
3176                       i = surf_usm_v(l)%i(m)
3177                       j = surf_usm_v(l)%j(m)
3178                       k = surf_usm_v(l)%k(m)
3179                       temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
3180                    ENDDO
3181                 ENDIF
3182
3183              ELSE
3184                 IF ( idsint == iup_u )  THEN
3185                    DO  m = 1, surf_usm_h%ns
3186                       i = surf_usm_h%i(m)
3187                       j = surf_usm_h%j(m)
3188                       k = surf_usm_h%k(m)
3189                       temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
3190                    ENDDO
3191                 ELSE
3192                    l = idsidx
3193                    DO  m = 1, surf_usm_v(l)%ns
3194                       i = surf_usm_v(l)%i(m)
3195                       j = surf_usm_v(l)%j(m)
3196                       k = surf_usm_v(l)%k(m)
3197                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
3198                    ENDDO
3199
3200                 ENDIF
3201
3202              ENDIF
3203
3204          CASE ( 'usm_t_surf_green' )
3205!
3206!--           surface temperature for green surfaces
3207              IF ( av == 0 )  THEN
3208                 IF ( idsint == iup_u )  THEN
3209                    DO  m = 1, surf_usm_h%ns
3210                       i = surf_usm_h%i(m)
3211                       j = surf_usm_h%j(m)
3212                       k = surf_usm_h%k(m)
3213                       temp_pf(k,j,i) = t_surf_green_h(m)
3214                    ENDDO
3215                 ELSE
3216                    l = idsidx
3217                    DO  m = 1, surf_usm_v(l)%ns
3218                       i = surf_usm_v(l)%i(m)
3219                       j = surf_usm_v(l)%j(m)
3220                       k = surf_usm_v(l)%k(m)
3221                       temp_pf(k,j,i) = t_surf_green_v(l)%t(m)
3222                    ENDDO
3223                 ENDIF
3224
3225              ELSE
3226                 IF ( idsint == iup_u )  THEN
3227                    DO  m = 1, surf_usm_h%ns
3228                       i = surf_usm_h%i(m)
3229                       j = surf_usm_h%j(m)
3230                       k = surf_usm_h%k(m)
3231                       temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
3232                    ENDDO
3233                 ELSE
3234                    l = idsidx
3235                    DO  m = 1, surf_usm_v(l)%ns
3236                       i = surf_usm_v(l)%i(m)
3237                       j = surf_usm_v(l)%j(m)
3238                       k = surf_usm_v(l)%k(m)
3239                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
3240                    ENDDO
3241
3242                 ENDIF
3243
3244              ENDIF
3245
3246          CASE ( 'usm_theta_10cm' )
3247!
3248!--           near surface temperature for whole surfaces
3249              IF ( av == 0 )  THEN
3250                 IF ( idsint == iup_u )  THEN
3251                    DO  m = 1, surf_usm_h%ns
3252                       i = surf_usm_h%i(m)
3253                       j = surf_usm_h%j(m)
3254                       k = surf_usm_h%k(m)
3255                       temp_pf(k,j,i) = surf_usm_h%pt_10cm(m)
3256                    ENDDO
3257                 ELSE
3258                    l = idsidx
3259                    DO  m = 1, surf_usm_v(l)%ns
3260                       i = surf_usm_v(l)%i(m)
3261                       j = surf_usm_v(l)%j(m)
3262                       k = surf_usm_v(l)%k(m)
3263                       temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm(m)
3264                    ENDDO
3265                 ENDIF
3266             
3267             
3268              ELSE
3269                 IF ( idsint == iup_u )  THEN
3270                    DO  m = 1, surf_usm_h%ns
3271                       i = surf_usm_h%i(m)
3272                       j = surf_usm_h%j(m)
3273                       k = surf_usm_h%k(m)
3274                       temp_pf(k,j,i) = surf_usm_h%pt_10cm_av(m)
3275                    ENDDO
3276                 ELSE
3277                    l = idsidx
3278                    DO  m = 1, surf_usm_v(l)%ns
3279                       i = surf_usm_v(l)%i(m)
3280                       j = surf_usm_v(l)%j(m)
3281                       k = surf_usm_v(l)%k(m)
3282                       temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm_av(m)
3283                    ENDDO
3284
3285                  ENDIF
3286              ENDIF
3287             
3288          CASE ( 'usm_t_wall' )
3289!
3290!--           wall temperature for  iwl layer of walls and land
3291              IF ( av == 0 )  THEN
3292                 IF ( idsint == iup_u )  THEN
3293                    DO  m = 1, surf_usm_h%ns
3294                       i = surf_usm_h%i(m)
3295                       j = surf_usm_h%j(m)
3296                       k = surf_usm_h%k(m)
3297                       temp_pf(k,j,i) = t_wall_h(iwl,m)
3298                    ENDDO
3299                 ELSE
3300                    l = idsidx
3301                    DO  m = 1, surf_usm_v(l)%ns
3302                       i = surf_usm_v(l)%i(m)
3303                       j = surf_usm_v(l)%j(m)
3304                       k = surf_usm_v(l)%k(m)
3305                       temp_pf(k,j,i) = t_wall_v(l)%t(iwl,m)
3306                    ENDDO
3307                 ENDIF
3308              ELSE
3309                 IF ( idsint == iup_u )  THEN
3310                    DO  m = 1, surf_usm_h%ns
3311                       i = surf_usm_h%i(m)
3312                       j = surf_usm_h%j(m)
3313                       k = surf_usm_h%k(m)
3314                       temp_pf(k,j,i) = surf_usm_h%t_wall_av(iwl,m)
3315                    ENDDO
3316                 ELSE
3317                    l = idsidx
3318                    DO  m = 1, surf_usm_v(l)%ns
3319                       i = surf_usm_v(l)%i(m)
3320                       j = surf_usm_v(l)%j(m)
3321                       k = surf_usm_v(l)%k(m)
3322                       temp_pf(k,j,i) = surf_usm_v(l)%t_wall_av(iwl,m)
3323                    ENDDO
3324                 ENDIF
3325              ENDIF
3326             
3327          CASE ( 'usm_t_window' )
3328!
3329!--           window temperature for iwl layer of walls and land
3330              IF ( av == 0 )  THEN
3331                 IF ( idsint == iup_u )  THEN
3332                    DO  m = 1, surf_usm_h%ns
3333                       i = surf_usm_h%i(m)
3334                       j = surf_usm_h%j(m)
3335                       k = surf_usm_h%k(m)
3336                       temp_pf(k,j,i) = t_window_h(iwl,m)
3337                    ENDDO
3338                 ELSE
3339                    l = idsidx
3340                    DO  m = 1, surf_usm_v(l)%ns
3341                       i = surf_usm_v(l)%i(m)
3342                       j = surf_usm_v(l)%j(m)
3343                       k = surf_usm_v(l)%k(m)
3344                       temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
3345                    ENDDO
3346                 ENDIF
3347              ELSE
3348                 IF ( idsint == iup_u )  THEN
3349                    DO  m = 1, surf_usm_h%ns
3350                       i = surf_usm_h%i(m)
3351                       j = surf_usm_h%j(m)
3352                       k = surf_usm_h%k(m)
3353                       temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
3354                    ENDDO
3355                 ELSE
3356                    l = idsidx
3357                    DO  m = 1, surf_usm_v(l)%ns
3358                       i = surf_usm_v(l)%i(m)
3359                       j = surf_usm_v(l)%j(m)
3360                       k = surf_usm_v(l)%k(m)
3361                       temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
3362                    ENDDO
3363                 ENDIF
3364              ENDIF
3365
3366          CASE ( 'usm_t_green' )
3367!
3368!--           green temperature for  iwl layer of walls and land
3369              IF ( av == 0 )  THEN
3370                 IF ( idsint == iup_u )  THEN
3371                    DO  m = 1, surf_usm_h%ns
3372                       i = surf_usm_h%i(m)
3373                       j = surf_usm_h%j(m)
3374                       k = surf_usm_h%k(m)
3375                       temp_pf(k,j,i) = t_green_h(iwl,m)
3376                    ENDDO
3377                 ELSE
3378                    l = idsidx
3379                    DO  m = 1, surf_usm_v(l)%ns
3380                       i = surf_usm_v(l)%i(m)
3381                       j = surf_usm_v(l)%j(m)
3382                       k = surf_usm_v(l)%k(m)
3383                       temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
3384                    ENDDO
3385                 ENDIF
3386              ELSE
3387                 IF ( idsint == iup_u )  THEN
3388                    DO  m = 1, surf_usm_h%ns
3389                       i = surf_usm_h%i(m)
3390                       j = surf_usm_h%j(m)
3391                       k = surf_usm_h%k(m)
3392                       temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
3393                    ENDDO
3394                 ELSE
3395                    l = idsidx
3396                    DO  m = 1, surf_usm_v(l)%ns
3397                       i = surf_usm_v(l)%i(m)
3398                       j = surf_usm_v(l)%j(m)
3399                       k = surf_usm_v(l)%k(m)
3400                       temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
3401                    ENDDO
3402                 ENDIF
3403              ENDIF
3404             
3405              CASE ( 'usm_swc' )
3406!
3407!--           soil water content for  iwl layer of walls and land
3408              IF ( av == 0 )  THEN
3409                 IF ( idsint == iup_u )  THEN
3410                    DO  m = 1, surf_usm_h%ns
3411                       i = surf_usm_h%i(m)
3412                       j = surf_usm_h%j(m)
3413                       k = surf_usm_h%k(m)
3414                       temp_pf(k,j,i) = swc_h(iwl,m)
3415                    ENDDO
3416                 ELSE
3417                    l = idsidx
3418                    DO  m = 1, surf_usm_v(l)%ns
3419                       i = surf_usm_v(l)%i(m)
3420                       j = surf_usm_v(l)%j(m)
3421                       k = surf_usm_v(l)%k(m)
3422                       temp_pf(k,j,i) = swc_v(l)%t(iwl,m)
3423                    ENDDO
3424                 ENDIF
3425              ELSE
3426                 IF ( idsint == iup_u )  THEN
3427                    DO  m = 1, surf_usm_h%ns
3428                       i = surf_usm_h%i(m)
3429                       j = surf_usm_h%j(m)
3430                       k = surf_usm_h%k(m)
3431                       temp_pf(k,j,i) = surf_usm_h%swc_av(iwl,m)
3432                    ENDDO
3433                 ELSE
3434                    l = idsidx
3435                    DO  m = 1, surf_usm_v(l)%ns
3436                       i = surf_usm_v(l)%i(m)
3437                       j = surf_usm_v(l)%j(m)
3438                       k = surf_usm_v(l)%k(m)
3439                       temp_pf(k,j,i) = surf_usm_v(l)%swc_av(iwl,m)
3440                    ENDDO
3441                 ENDIF
3442              ENDIF
3443
3444             
3445          CASE DEFAULT
3446              found = .FALSE.
3447              RETURN
3448        END SELECT
3449
3450!
3451!--     Rearrange dimensions for NetCDF output
3452!--     FIXME: this may generate FPE overflow upon conversion from DP to SP
3453        DO  j = nys, nyn
3454            DO  i = nxl, nxr
3455                DO  k = nzb_do, nzt_do
3456                    local_pf(i,j,k) = temp_pf(k,j,i)
3457                ENDDO
3458            ENDDO
3459        ENDDO
3460       
3461    END SUBROUTINE usm_data_output_3d
3462   
3463
3464!------------------------------------------------------------------------------!
3465!
3466! Description:
3467! ------------
3468!> Soubroutine defines appropriate grid for netcdf variables.
3469!> It is called out from subroutine netcdf.
3470!------------------------------------------------------------------------------!
3471    SUBROUTINE usm_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
3472   
3473        IMPLICIT NONE
3474
3475        CHARACTER (len=*), INTENT(IN)  ::  variable    !<
3476        LOGICAL, INTENT(OUT)           ::  found       !<
3477        CHARACTER (len=*), INTENT(OUT) ::  grid_x      !<
3478        CHARACTER (len=*), INTENT(OUT) ::  grid_y      !<
3479        CHARACTER (len=*), INTENT(OUT) ::  grid_z      !<
3480
3481        CHARACTER (len=varnamelength)  :: var
3482
3483        var = TRIM(variable)
3484        IF ( var(1:9) == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_'  .OR.                   &
3485             var(1:16) == 'usm_wghf_window_'  .OR. var(1:15) == 'usm_wghf_green_' .OR.      &
3486             var(1:10) == 'usm_iwghf_'  .OR. var(1:17) == 'usm_iwghf_window_' .OR.          &
3487             var(1:9) == 'usm_qsws_'  .OR.  var(1:13) == 'usm_qsws_veg_'  .OR.              &
3488             var(1:13) == 'usm_qsws_liq_' .OR.                                              &
3489             var(1:15) == 'usm_t_surf_wall'  .OR.  var(1:10) == 'usm_t_wall'  .OR.          &
3490             var(1:17) == 'usm_t_surf_window'  .OR.  var(1:12) == 'usm_t_window'  .OR.      &
3491             var(1:16) == 'usm_t_surf_green'  .OR. var(1:11) == 'usm_t_green' .OR.          &
3492             var(1:15) == 'usm_theta_10cm' .OR.                                             &
3493             var(1:9) == 'usm_surfz'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                &
3494             var(1:16) == 'usm_surfwintrans'  .OR. var(1:7) == 'usm_swc' ) THEN
3495
3496            found = .TRUE.
3497            grid_x = 'x'
3498            grid_y = 'y'
3499            grid_z = 'zu'
3500        ELSE
3501            found  = .FALSE.
3502            grid_x = 'none'
3503            grid_y = 'none'
3504            grid_z = 'none'
3505        ENDIF
3506
3507    END SUBROUTINE usm_define_netcdf_grid
3508   
3509
3510!------------------------------------------------------------------------------!
3511! Description:
3512! ------------
3513!> Initialization of the wall surface model
3514!------------------------------------------------------------------------------!
3515    SUBROUTINE usm_init_material_model
3516
3517        IMPLICIT NONE
3518
3519        INTEGER(iwp) ::  k, l, m            !< running indices
3520       
3521        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'start' )
3522
3523!
3524!--     Calculate wall grid spacings.
3525!--     Temperature is defined at the center of the wall layers,
3526!--     whereas gradients/fluxes are defined at the edges (_stag)     
3527!--     apply for all particular surface grids. First for horizontal surfaces
3528        DO  m = 1, surf_usm_h%ns
3529
3530           surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
3531           DO k = nzb_wall+1, nzt_wall
3532               surf_usm_h%dz_wall(k,m) = surf_usm_h%zw(k,m) -                  &
3533                                         surf_usm_h%zw(k-1,m)
3534           ENDDO
3535           surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
3536           DO k = nzb_wall+1, nzt_wall
3537               surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) -         &
3538                                         surf_usm_h%zw_window(k-1,m)
3539           ENDDO
3540           
3541           surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
3542
3543           DO k = nzb_wall, nzt_wall-1
3544               surf_usm_h%dz_wall_stag(k,m) = 0.5 * (                          &
3545                           surf_usm_h%dz_wall(k+1,m) + surf_usm_h%dz_wall(k,m) )
3546           ENDDO
3547           surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
3548           
3549           surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
3550
3551           DO k = nzb_wall, nzt_wall-1
3552               surf_usm_h%dz_window_stag(k,m) = 0.5 * (                        &
3553                           surf_usm_h%dz_window(k+1,m) + surf_usm_h%dz_window(k,m) )
3554           ENDDO
3555           surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
3556
3557           IF (surf_usm_h%green_type_roof(m) == 2.0_wp ) THEN
3558!
3559!-- extensive green roof
3560!-- set ratio of substrate layer thickness, soil-type and LAI
3561              soil_type = 3
3562              surf_usm_h%lai(m) = 2.0_wp
3563             
3564              surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3565              surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3566              surf_usm_h%zw_green(nzb_wall+2,m) = 0.15_wp
3567              surf_usm_h%zw_green(nzb_wall+3,m) = 0.20_wp
3568           ELSE
3569!
3570!-- intensiv green roof
3571!-- set ratio of substrate layer thickness, soil-type and LAI
3572              soil_type = 6
3573              surf_usm_h%lai(m) = 4.0_wp
3574             
3575              surf_usm_h%zw_green(nzb_wall,m)   = 0.05_wp
3576              surf_usm_h%zw_green(nzb_wall+1,m) = 0.10_wp
3577              surf_usm_h%zw_green(nzb_wall+2,m) = 0.40_wp
3578              surf_usm_h%zw_green(nzb_wall+3,m) = 0.80_wp
3579           ENDIF
3580           
3581           surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
3582           DO k = nzb_wall+1, nzt_wall
3583               surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) -           &
3584                                         surf_usm_h%zw_green(k-1,m)
3585           ENDDO
3586           surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
3587
3588           DO k = nzb_wall, nzt_wall-1
3589               surf_usm_h%dz_green_stag(k,m) = 0.5 * (                         &
3590                           surf_usm_h%dz_green(k+1,m) + surf_usm_h%dz_green(k,m) )
3591           ENDDO
3592           surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
3593           
3594          IF ( alpha_vangenuchten == 9999999.9_wp )  THEN
3595             alpha_vangenuchten = soil_pars(0,soil_type)
3596          ENDIF
3597
3598          IF ( l_vangenuchten == 9999999.9_wp )  THEN
3599             l_vangenuchten = soil_pars(1,soil_type)
3600          ENDIF
3601
3602          IF ( n_vangenuchten == 9999999.9_wp )  THEN
3603             n_vangenuchten = soil_pars(2,soil_type)           
3604          ENDIF
3605
3606          IF ( hydraulic_conductivity == 9999999.9_wp )  THEN
3607             hydraulic_conductivity = soil_pars(3,soil_type)           
3608          ENDIF
3609
3610          IF ( saturation_moisture == 9999999.9_wp )  THEN
3611             saturation_moisture = m_soil_pars(0,soil_type)           
3612          ENDIF
3613
3614          IF ( field_capacity == 9999999.9_wp )  THEN
3615             field_capacity = m_soil_pars(1,soil_type)           
3616          ENDIF
3617
3618          IF ( wilting_point == 9999999.9_wp )  THEN
3619             wilting_point = m_soil_pars(2,soil_type)           
3620          ENDIF
3621
3622          IF ( residual_moisture == 9999999.9_wp )  THEN
3623             residual_moisture = m_soil_pars(3,soil_type)       
3624          ENDIF
3625         
3626          DO k = nzb_wall, nzt_wall+1
3627             swc_h(k,m) = field_capacity
3628             rootfr_h(k,m) = 0.5_wp
3629             surf_usm_h%alpha_vg_green(m)      = alpha_vangenuchten
3630             surf_usm_h%l_vg_green(m)          = l_vangenuchten
3631             surf_usm_h%n_vg_green(m)          = n_vangenuchten 
3632             surf_usm_h%gamma_w_green_sat(k,m) = hydraulic_conductivity
3633             swc_sat_h(k,m)                    = saturation_moisture
3634             fc_h(k,m)                         = field_capacity
3635             wilt_h(k,m)                       = wilting_point
3636             swc_res_h(k,m)                    = residual_moisture
3637          ENDDO
3638
3639        ENDDO
3640
3641        surf_usm_h%ddz_wall        = 1.0_wp / surf_usm_h%dz_wall
3642        surf_usm_h%ddz_wall_stag   = 1.0_wp / surf_usm_h%dz_wall_stag
3643        surf_usm_h%ddz_window      = 1.0_wp / surf_usm_h%dz_window
3644        surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
3645        surf_usm_h%ddz_green       = 1.0_wp / surf_usm_h%dz_green
3646        surf_usm_h%ddz_green_stag  = 1.0_wp / surf_usm_h%dz_green_stag
3647!       
3648!--     For vertical surfaces
3649        DO  l = 0, 3
3650           DO  m = 1, surf_usm_v(l)%ns
3651              surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
3652              DO k = nzb_wall+1, nzt_wall
3653                  surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) -         &
3654                                               surf_usm_v(l)%zw(k-1,m)
3655              ENDDO
3656              surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
3657              DO k = nzb_wall+1, nzt_wall
3658                  surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) - &
3659                                               surf_usm_v(l)%zw_window(k-1,m)
3660              ENDDO
3661              surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
3662              DO k = nzb_wall+1, nzt_wall
3663                  surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) - &
3664                                               surf_usm_v(l)%zw_green(k-1,m)
3665              ENDDO
3666           
3667              surf_usm_v(l)%dz_wall(nzt_wall+1,m) =                            &
3668                                              surf_usm_v(l)%dz_wall(nzt_wall,m)
3669
3670              DO k = nzb_wall, nzt_wall-1
3671                  surf_usm_v(l)%dz_wall_stag(k,m) = 0.5 * (                    &
3672                                                surf_usm_v(l)%dz_wall(k+1,m) + &
3673                                                surf_usm_v(l)%dz_wall(k,m) )
3674              ENDDO
3675              surf_usm_v(l)%dz_wall_stag(nzt_wall,m) =                         &
3676                                              surf_usm_v(l)%dz_wall(nzt_wall,m)
3677              surf_usm_v(l)%dz_window(nzt_wall+1,m) =                          &
3678                                              surf_usm_v(l)%dz_window(nzt_wall,m)
3679
3680              DO k = nzb_wall, nzt_wall-1
3681                  surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * (                    &
3682                                                surf_usm_v(l)%dz_window(k+1,m) + &
3683                                                surf_usm_v(l)%dz_window(k,m) )
3684              ENDDO
3685              surf_usm_v(l)%dz_window_stag(nzt_wall,m) =                         &
3686                                              surf_usm_v(l)%dz_window(nzt_wall,m)
3687              surf_usm_v(l)%dz_green(nzt_wall+1,m) =                             &
3688                                              surf_usm_v(l)%dz_green(nzt_wall,m)
3689
3690              DO k = nzb_wall, nzt_wall-1
3691                  surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * (                    &
3692                                                surf_usm_v(l)%dz_green(k+1,m) + &
3693                                                surf_usm_v(l)%dz_green(k,m) )
3694              ENDDO
3695              surf_usm_v(l)%dz_green_stag(nzt_wall,m) =                         &
3696                                              surf_usm_v(l)%dz_green(nzt_wall,m)
3697           ENDDO
3698           surf_usm_v(l)%ddz_wall        = 1.0_wp / surf_usm_v(l)%dz_wall
3699           surf_usm_v(l)%ddz_wall_stag   = 1.0_wp / surf_usm_v(l)%dz_wall_stag
3700           surf_usm_v(l)%ddz_window      = 1.0_wp / surf_usm_v(l)%dz_window
3701           surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
3702           surf_usm_v(l)%ddz_green       = 1.0_wp / surf_usm_v(l)%dz_green
3703           surf_usm_v(l)%ddz_green_stag  = 1.0_wp / surf_usm_v(l)%dz_green_stag
3704        ENDDO     
3705
3706       
3707        IF ( debug_output )  CALL debug_message( 'usm_init_material_model', 'end' )
3708
3709    END SUBROUTINE usm_init_material_model
3710
3711 
3712!------------------------------------------------------------------------------!
3713! Description:
3714! ------------
3715!> Initialization of the urban surface model
3716!------------------------------------------------------------------------------!
3717    SUBROUTINE usm_init
3718
3719        USE arrays_3d,                                                         &
3720            ONLY:  zw
3721
3722        USE netcdf_data_input_mod,                                             &
3723            ONLY:  building_pars_f, building_type_f, terrain_height_f
3724   
3725        IMPLICIT NONE
3726
3727        INTEGER(iwp) ::  i                   !< loop index x-dirction
3728        INTEGER(iwp) ::  ind_alb_green       !< index in input list for green albedo
3729        INTEGER(iwp) ::  ind_alb_wall        !< index in input list for wall albedo
3730        INTEGER(iwp) ::  ind_alb_win         !< index in input list for window albedo
3731        INTEGER(iwp) ::  ind_emis_wall       !< index in input list for wall emissivity
3732        INTEGER(iwp) ::  ind_emis_green      !< index in input list for green emissivity
3733        INTEGER(iwp) ::  ind_emis_win        !< index in input list for window emissivity
3734        INTEGER(iwp) ::  ind_green_frac_w    !< index in input list for green fraction on wall
3735        INTEGER(iwp) ::  ind_green_frac_r    !< index in input list for green fraction on roof
3736        INTEGER(iwp) ::  ind_hc1             !< index in input list for heat capacity at first wall layer
3737        INTEGER(iwp) ::  ind_hc1_win         !< index in input list for heat capacity at first window layer
3738        INTEGER(iwp) ::  ind_hc2             !< index in input list for heat capacity at second wall layer
3739        INTEGER(iwp) ::  ind_hc2_win         !< index in input list for heat capacity at second window layer
3740        INTEGER(iwp) ::  ind_hc3             !< index in input list for heat capacity at third wall layer
3741        INTEGER(iwp) ::  ind_hc3_win         !< index in input list for heat capacity at third window layer
3742        INTEGER(iwp) ::  ind_lai_r           !< index in input list for LAI on roof
3743        INTEGER(iwp) ::  ind_lai_w           !< index in input list for LAI on wall
3744        INTEGER(iwp) ::  ind_tc1             !< index in input list for thermal conductivity at first wall layer
3745        INTEGER(iwp) ::  ind_tc1_win         !< index in input list for thermal conductivity at first window layer
3746        INTEGER(iwp) ::  ind_tc2             !< index in input list for thermal conductivity at second wall layer
3747        INTEGER(iwp) ::  ind_tc2_win         !< index in input list for thermal conductivity at second window layer
3748        INTEGER(iwp) ::  ind_tc3             !< index in input list for thermal conductivity at third wall layer
3749        INTEGER(iwp) ::  ind_tc3_win         !< index in input list for thermal conductivity at third window layer
3750        INTEGER(iwp) ::  ind_thick_1         !< index in input list for thickness of first wall layer
3751        INTEGER(iwp) ::  ind_thick_1_win     !< index in input list for thickness of first window layer
3752        INTEGER(iwp) ::  ind_thick_2         !< index in input list for thickness of second wall layer
3753        INTEGER(iwp) ::  ind_thick_2_win     !< index in input list for thickness of second window layer
3754        INTEGER(iwp) ::  ind_thick_3         !< index in input list for thickness of third wall layer
3755        INTEGER(iwp) ::  ind_thick_3_win     !< index in input list for thickness of third window layer
3756        INTEGER(iwp) ::  ind_thick_4         !< index in input list for thickness of fourth wall layer
3757        INTEGER(iwp) ::  ind_thick_4_win     !< index in input list for thickness of fourth window layer
3758        INTEGER(iwp) ::  ind_trans           !< index in input list for window transmissivity
3759        INTEGER(iwp) ::  ind_wall_frac       !< index in input list for wall fraction
3760        INTEGER(iwp) ::  ind_win_frac        !< index in input list for window fraction
3761        INTEGER(iwp) ::  ind_z0              !< index in input list for z0
3762        INTEGER(iwp) ::  ind_z0qh            !< index in input list for z0h / z0q
3763        INTEGER(iwp) ::  j                   !< loop index y-dirction
3764        INTEGER(iwp) ::  k                   !< loop index z-dirction
3765        INTEGER(iwp) ::  l                   !< loop index surface orientation
3766        INTEGER(iwp) ::  m                   !< loop index surface element
3767        INTEGER(iwp) ::  st                  !< dummy 
3768
3769        REAL(wp)     ::  c, tin, twin
3770        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
3771        REAL(wp)     ::  z_agl                        !< height above ground
3772
3773        IF ( debug_output )  CALL debug_message( 'usm_init', 'start' )
3774
3775        CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
3776!
3777!--     Initialize building-surface properties
3778        CALL usm_define_pars
3779!
3780!--     surface forcing have to be disabled for LSF
3781!--     in case of enabled urban surface module
3782        IF ( large_scale_forcing )  THEN
3783            lsf_surf = .FALSE.
3784        ENDIF
3785!
3786!--     Flag surface elements belonging to the ground floor level. Therefore,
3787!--     use terrain height array from file, if available. This flag is later used
3788!--     to control initialization of surface attributes.
3789!--     Todo: for the moment disable initialization of building roofs with
3790!--     ground-floor-level properties.
3791        surf_usm_h%ground_level = .FALSE. 
3792
3793        DO  l = 0, 3
3794           surf_usm_v(l)%ground_level = .FALSE.
3795           DO  m = 1, surf_usm_v(l)%ns
3796              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
3797              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
3798              k = surf_usm_v(l)%k(m)
3799!
3800!--           Determine local ground level. Level 1 - default value,
3801!--           level 2 - initialization according to building type,
3802!--           level 3 - initialization from value read from file.
3803              ground_floor_level_l = ground_floor_level
3804             
3805              IF ( building_type_f%from_file )  THEN
3806                  ground_floor_level_l =                                       &
3807                              building_pars(ind_gflh,building_type_f%var(j,i))
3808              ENDIF
3809             
3810              IF ( building_pars_f%from_file )  THEN
3811                 IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=                 &
3812                      building_pars_f%fill )                                   &
3813                    ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
3814              ENDIF
3815!
3816!--           Determine height of surface element above ground level. Please
3817!--           note, height of surface element is determined with respect to
3818!--           its height above ground of the reference grid point in atmosphere,
3819!--           Therefore, substract the offset values when assessing the terrain
3820!--           height.
3821              IF ( terrain_height_f%from_file )  THEN
3822                 z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff,    &
3823                                                      i-surf_usm_v(l)%ioff)
3824              ELSE
3825                 z_agl = zw(k)
3826              ENDIF
3827!
3828!--           Set flag for ground level
3829              IF ( z_agl <= ground_floor_level_l )                             &
3830                 surf_usm_v(l)%ground_level(m) = .TRUE.
3831
3832           ENDDO
3833        ENDDO
3834!
3835!--     Initialization of resistances.
3836        DO  m = 1, surf_usm_h%ns
3837           surf_usm_h%r_a(m)        = 50.0_wp
3838           surf_usm_h%r_a_green(m)  = 50.0_wp
3839           surf_usm_h%r_a_window(m) = 50.0_wp
3840        ENDDO
3841        DO  l = 0, 3
3842           DO  m = 1, surf_usm_v(l)%ns
3843              surf_usm_v(l)%r_a(m)        = 50.0_wp
3844              surf_usm_v(l)%r_a_green(m)  = 50.0_wp
3845              surf_usm_v(l)%r_a_window(m) = 50.0_wp
3846           ENDDO
3847        ENDDO
3848       
3849!
3850!--    Map values onto horizontal elemements
3851       DO  m = 1, surf_usm_h%ns
3852             surf_usm_h%r_canopy_min(m)     = 200.0_wp !< min_canopy_resistance
3853             surf_usm_h%g_d(m)              = 0.0_wp   !< canopy_resistance_coefficient
3854       ENDDO
3855!
3856!--    Map values onto vertical elements, even though this does not make
3857!--    much sense.
3858       DO  l = 0, 3
3859          DO  m = 1, surf_usm_v(l)%ns
3860                surf_usm_v(l)%r_canopy_min(m)     = 200.0_wp !< min_canopy_resistance
3861                surf_usm_v(l)%g_d(m)              = 0.0_wp   !< canopy_resistance_coefficient
3862          ENDDO
3863       ENDDO
3864
3865!
3866!--     Initialize urban-type surface attribute. According to initialization in
3867!--     land-surface model, follow a 3-level approach.
3868!--     Level 1 - initialization via default attributes
3869        DO  m = 1, surf_usm_h%ns
3870!
3871!--        Now, all horizontal surfaces are roof surfaces (?)
3872           surf_usm_h%isroof_surf(m)   = .TRUE.
3873           surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
3874!
3875!--        In order to distinguish between ground floor level and
3876!--        above-ground-floor level surfaces, set input indices.
3877
3878           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3879                                     surf_usm_h%ground_level(m) )
3880           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
3881                                     surf_usm_h%ground_level(m) )
3882           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
3883                                     surf_usm_h%ground_level(m) )
3884           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
3885                                     surf_usm_h%ground_level(m) )
3886!
3887!--        Store building type and its name on each surface element
3888           surf_usm_h%building_type(m)      = building_type
3889           surf_usm_h%building_type_name(m) = building_type_name(building_type)
3890!
3891!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
3892           surf_usm_h%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac_r,building_type)   
3893           surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,building_type) 
3894           surf_usm_h%frac(ind_wat_win,m)   = building_pars(ind_win_frac_r,building_type) 
3895           surf_usm_h%lai(m)                = building_pars(ind_lai_r,building_type) 
3896
3897           surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,building_type) 
3898           surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1_wall_r,building_type)
3899           surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2_wall_r,building_type)
3900           surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3_wall_r,building_type)   
3901           surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1_wall_r,building_type) 
3902           surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1_wall_r,building_type) 
3903           surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2_wall_r,building_type)
3904           surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3_wall_r,building_type)   
3905           surf_usm_h%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1_wall_r,building_type) 
3906           surf_usm_h%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1_wall_r,building_type)
3907           surf_usm_h%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2_wall_r,building_type)
3908           surf_usm_h%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3_wall_r,building_type)   
3909           surf_usm_h%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type) 
3910           surf_usm_h%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,building_type)
3911           surf_usm_h%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,building_type)
3912           surf_usm_h%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,building_type)
3913           surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win_r,building_type) 
3914           surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win_r,building_type)
3915           surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win_r,building_type)
3916           surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win_r,building_type)   
3917           surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,building_type) 
3918           surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,building_type) 
3919           surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,building_type)
3920           surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,building_type)   
3921
3922           surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)   
3923           surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)   
3924!
3925!--        emissivity of wall-, green- and window fraction
3926           surf_usm_h%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall_r,building_type)
3927           surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green_r,building_type)
3928           surf_usm_h%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win_r,building_type)
3929
3930           surf_usm_h%transmissivity(m)      = building_pars(ind_trans_r,building_type)
3931
3932           surf_usm_h%z0(m)                  = building_pars(ind_z0,building_type)
3933           surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,building_type)
3934           surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,building_type)
3935!
3936!--        albedo type for wall fraction, green fraction, window fraction
3937           surf_usm_h%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall_r,building_type)  )
3938           surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green_r,building_type) )
3939           surf_usm_h%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win_r,building_type)   )
3940
3941           surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3942           surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3943           surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3944           surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3945           
3946           surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,building_type)
3947           surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,building_type)
3948           surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,building_type)
3949           surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,building_type)
3950           
3951           surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,building_type)
3952           surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,building_type)
3953           surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,building_type)
3954           surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,building_type)
3955
3956           surf_usm_h%c_surface(m)           = building_pars(ind_c_surface,building_type) 
3957           surf_usm_h%lambda_surf(m)         = building_pars(ind_lambda_surf,building_type) 
3958           surf_usm_h%c_surface_green(m)     = building_pars(ind_c_surface_green,building_type) 
3959           surf_usm_h%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,building_type) 
3960           surf_usm_h%c_surface_window(m)    = building_pars(ind_c_surface_win,building_type) 
3961           surf_usm_h%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,building_type) 
3962           
3963           surf_usm_h%green_type_roof(m)     = building_pars(ind_green_type_roof,building_type)
3964
3965        ENDDO
3966
3967        DO  l = 0, 3
3968           DO  m = 1, surf_usm_v(l)%ns
3969
3970              surf_usm_v(l)%surface_types(m) = wall_category         !< default category for root surface
3971!
3972!--           In order to distinguish between ground floor level and
3973!--           above-ground-floor level surfaces, set input indices.
3974              ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,    &
3975                                        surf_usm_v(l)%ground_level(m) )
3976              ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,     &
3977                                        surf_usm_v(l)%ground_level(m) )
3978              ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,      &
3979                                        surf_usm_v(l)%ground_level(m) )
3980              ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
3981                                        surf_usm_v(l)%ground_level(m) )
3982              ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
3983                                        surf_usm_v(l)%ground_level(m) )
3984              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
3985                                        surf_usm_v(l)%ground_level(m) )
3986              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3987                                        surf_usm_v(l)%ground_level(m) )
3988              ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
3989                                        surf_usm_v(l)%ground_level(m) )
3990              ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
3991                                        surf_usm_v(l)%ground_level(m) )
3992              ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
3993                                        surf_usm_v(l)%ground_level(m) )
3994              ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,      &
3995                                        surf_usm_v(l)%ground_level(m) )
3996              ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
3997                                        surf_usm_v(l)%ground_level(m) )
3998              ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,      &
3999                                        surf_usm_v(l)%ground_level(m) )
4000              ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
4001                                        surf_usm_v(l)%ground_level(m) )
4002              ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,      &
4003                                        surf_usm_v(l)%ground_level(m) )
4004              ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
4005                                        surf_usm_v(l)%ground_level(m) )
4006              ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,      &
4007                                        surf_usm_v(l)%ground_level(m) )
4008              ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
4009                                        surf_usm_v(l)%ground_level(m) )
4010              ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,      &
4011                                        surf_usm_v(l)%ground_level(m) )
4012              ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
4013                                        surf_usm_v(l)%ground_level(m) )
4014              ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,      &
4015                                        surf_usm_v(l)%ground_level(m) )
4016              ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,      &
4017                                        surf_usm_v(l)%ground_level(m) )
4018              ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,  &
4019                                        surf_usm_v(l)%ground_level(m) )
4020              ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,      &
4021                                        surf_usm_v(l)%ground_level(m) )
4022              ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,  &
4023                                        surf_usm_v(l)%ground_level(m) )
4024              ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,      &
4025                                        surf_usm_v(l)%ground_level(m) )
4026              ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,  &
4027                                        surf_usm_v(l)%ground_level(m) )
4028              ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,      &
4029                                        surf_usm_v(l)%ground_level(m) )
4030              ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,  &
4031                                        surf_usm_v(l)%ground_level(m) )
4032              ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
4033                                        surf_usm_v(l)%ground_level(m) )
4034              ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
4035                                        surf_usm_v(l)%ground_level(m) )
4036              ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
4037                                        surf_usm_v(l)%ground_level(m) )
4038              ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
4039                                        surf_usm_v(l)%ground_level(m) )
4040              ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4041                                        surf_usm_v(l)%ground_level(m) )
4042              ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4043                                        surf_usm_v(l)%ground_level(m) )
4044!
4045!--           Store building type and its name on each surface element
4046              surf_usm_v(l)%building_type(m)      = building_type
4047              surf_usm_v(l)%building_type_name(m) = building_type_name(building_type)
4048!
4049!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
4050              surf_usm_v(l)%frac(ind_veg_wall,m)   = building_pars(ind_wall_frac,building_type)   
4051              surf_usm_v(l)%frac(ind_pav_green,m)  = building_pars(ind_green_frac_w,building_type) 
4052              surf_usm_v(l)%frac(ind_wat_win,m)    = building_pars(ind_win_frac,building_type) 
4053              surf_usm_v(l)%lai(m)                 = building_pars(ind_lai_w,building_type) 
4054
4055              surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
4056              surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
4057              surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
4058              surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
4059             
4060              surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,building_type) 
4061              surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,building_type)
4062              surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,building_type)
4063              surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,building_type)   
4064             
4065              surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,building_type) 
4066              surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,building_type)
4067              surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,building_type)
4068              surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,building_type)   
4069
4070              surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
4071              surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
4072              surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
4073              surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
4074             
4075              surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,building_type) 
4076              surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,building_type)
4077              surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,building_type)
4078              surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,building_type)   
4079
4080              surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,building_type) 
4081              surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,building_type) 
4082              surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,building_type)
4083              surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,building_type)   
4084
4085              surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,building_type)   
4086              surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)   
4087!
4088!--           emissivity of wall-, green- and window fraction
4089              surf_usm_v(l)%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall,building_type)
4090              surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,building_type)
4091              surf_usm_v(l)%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win,building_type)
4092
4093              surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,building_type)
4094
4095              surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,building_type)
4096              surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,building_type)
4097              surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,building_type)
4098
4099              surf_usm_v(l)%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall,building_type) )
4100              surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,building_type) )
4101              surf_usm_v(l)%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win,building_type) )
4102
4103              surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
4104              surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
4105              surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
4106              surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
4107             
4108              surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
4109              surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
4110              surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
4111              surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
4112
4113              surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win,building_type)
4114              surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win,building_type)
4115              surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win,building_type)
4116              surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win,building_type)
4117
4118              surf_usm_v(l)%c_surface(m)           = building_pars(ind_c_surface,building_type) 
4119              surf_usm_v(l)%lambda_surf(m)         = building_pars(ind_lambda_surf,building_type)
4120              surf_usm_v(l)%c_surface_green(m)     = building_pars(ind_c_surface_green,building_type) 
4121              surf_usm_v(l)%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,building_type)
4122              surf_usm_v(l)%c_surface_window(m)    = building_pars(ind_c_surface_win,building_type) 
4123              surf_usm_v(l)%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,building_type)
4124
4125           ENDDO
4126        ENDDO
4127!
4128!--     Level 2 - initialization via building type read from file
4129        IF ( building_type_f%from_file )  THEN
4130           DO  m = 1, surf_usm_h%ns
4131              i = surf_usm_h%i(m)
4132              j = surf_usm_h%j(m)
4133!
4134!--           For the moment, limit building type to 6 (to overcome errors in input file).
4135              st = building_type_f%var(j,i)
4136              IF ( st /= building_type_f%fill )  THEN
4137
4138!
4139!--              In order to distinguish between ground floor level and
4140!--              above-ground-floor level surfaces, set input indices.
4141
4142                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4143                                           surf_usm_h%ground_level(m) )
4144                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
4145                                           surf_usm_h%ground_level(m) )
4146                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4147                                           surf_usm_h%ground_level(m) )
4148                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4149                                           surf_usm_h%ground_level(m) )
4150!
4151!--              Store building type and its name on each surface element
4152                 surf_usm_h%building_type(m)      = st
4153                 surf_usm_h%building_type_name(m) = building_type_name(st)
4154!
4155!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
4156                 surf_usm_h%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac_r,st)   
4157                 surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,st) 
4158                 surf_usm_h%frac(ind_wat_win,m)   = building_pars(ind_win_frac_r,st) 
4159                 surf_usm_h%lai(m)                = building_pars(ind_lai_r,st) 
4160
4161                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1_wall_r,st) 
4162                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1_wall_r,st)
4163                 surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2_wall_r,st)
4164                 surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3_wall_r,st)   
4165                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1_wall_r,st) 
4166                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1_wall_r,st) 
4167                 surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2_wall_r,st)
4168                 surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3_wall_r,st)   
4169                 
4170                 surf_usm_h%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1_wall_r,st) 
4171                 surf_usm_h%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1_wall_r,st)
4172                 surf_usm_h%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2_wall_r,st)
4173                 surf_usm_h%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3_wall_r,st)   
4174                 surf_usm_h%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st) 
4175                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1_wall_r,st)
4176                 surf_usm_h%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2_wall_r,st)
4177                 surf_usm_h%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3_wall_r,st)   
4178               
4179                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win_r,st) 
4180                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win_r,st)
4181                 surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win_r,st)
4182                 surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win_r,st)   
4183                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win_r,st) 
4184                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win_r,st) 
4185                 surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win_r,st)
4186                 surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win_r,st)   
4187
4188                 surf_usm_h%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)   
4189                 surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)   
4190!
4191!--              emissivity of wall-, green- and window fraction
4192                 surf_usm_h%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall_r,st)
4193                 surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green_r,st)
4194                 surf_usm_h%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win_r,st)
4195
4196                 surf_usm_h%transmissivity(m)      = building_pars(ind_trans_r,st)
4197
4198                 surf_usm_h%z0(m)                  = building_pars(ind_z0,st)
4199                 surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,st)
4200                 surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
4201!
4202!--              albedo type for wall fraction, green fraction, window fraction
4203                 surf_usm_h%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall_r,st) )
4204                 surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green_r,st) )
4205                 surf_usm_h%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win_r,st) )
4206
4207                 surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,st)
4208                 surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,st)
4209                 surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,st)
4210                 surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,st)
4211                 
4212                 surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1_wall_r,st)
4213                 surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2_wall_r,st)
4214                 surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3_wall_r,st)
4215                 surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4_wall_r,st)
4216
4217                 surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win_r,st)
4218                 surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win_r,st)
4219                 surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win_r,st)
4220                 surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win_r,st)
4221
4222                 surf_usm_h%c_surface(m)           = building_pars(ind_c_surface,st) 
4223                 surf_usm_h%lambda_surf(m)         = building_pars(ind_lambda_surf,st)
4224                 surf_usm_h%c_surface_green(m)     = building_pars(ind_c_surface_green,st) 
4225                 surf_usm_h%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,st)
4226                 surf_usm_h%c_surface_window(m)    = building_pars(ind_c_surface_win,st) 
4227                 surf_usm_h%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,st)
4228                 
4229                 surf_usm_h%green_type_roof(m)     = building_pars(ind_green_type_roof,st)
4230
4231              ENDIF
4232           ENDDO
4233
4234           DO  l = 0, 3
4235              DO  m = 1, surf_usm_v(l)%ns
4236                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4237                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4238!
4239!--              For the moment, limit building type to 6 (to overcome errors in input file).
4240
4241                 st = building_type_f%var(j,i)
4242                 IF ( st /= building_type_f%fill )  THEN
4243
4244!
4245!--                 In order to distinguish between ground floor level and
4246!--                 above-ground-floor level surfaces, set input indices.
4247                    ind_alb_green    = MERGE( ind_alb_green_gfl,    ind_alb_green_agfl,    &
4248                                              surf_usm_v(l)%ground_level(m) )
4249                    ind_alb_wall     = MERGE( ind_alb_wall_gfl,     ind_alb_wall_agfl,     &
4250                                              surf_usm_v(l)%ground_level(m) )
4251                    ind_alb_win      = MERGE( ind_alb_win_gfl,      ind_alb_win_agfl,      &
4252                                              surf_usm_v(l)%ground_level(m) )
4253                    ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
4254                                              surf_usm_v(l)%ground_level(m) )
4255                    ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
4256                                              surf_usm_v(l)%ground_level(m) )
4257                    ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
4258                                              surf_usm_v(l)%ground_level(m) )
4259                    ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4260                                              surf_usm_v(l)%ground_level(m) )
4261                    ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
4262                                              surf_usm_v(l)%ground_level(m) )
4263                    ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
4264                                              surf_usm_v(l)%ground_level(m) )
4265                    ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
4266                                              surf_usm_v(l)%ground_level(m) )
4267                    ind_hc1_win      = MERGE( ind_hc1_win_gfl,      ind_hc1_win_agfl,      &
4268                                              surf_usm_v(l)%ground_level(m) )
4269                    ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
4270                                              surf_usm_v(l)%ground_level(m) )
4271                    ind_hc2_win      = MERGE( ind_hc2_win_gfl,      ind_hc2_win_agfl,      &
4272                                              surf_usm_v(l)%ground_level(m) )
4273                    ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
4274                                              surf_usm_v(l)%ground_level(m) )
4275                    ind_hc3_win      = MERGE( ind_hc3_win_gfl,      ind_hc3_win_agfl,      &
4276                                              surf_usm_v(l)%ground_level(m) )
4277                    ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
4278                                              surf_usm_v(l)%ground_level(m) )
4279                    ind_tc1_win      = MERGE( ind_tc1_win_gfl,      ind_tc1_win_agfl,      &
4280                                              surf_usm_v(l)%ground_level(m) )
4281                    ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
4282                                              surf_usm_v(l)%ground_level(m) )
4283                    ind_tc2_win      = MERGE( ind_tc2_win_gfl,      ind_tc2_win_agfl,      &
4284                                              surf_usm_v(l)%ground_level(m) )
4285                    ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
4286                                              surf_usm_v(l)%ground_level(m) )
4287                    ind_tc3_win      = MERGE( ind_tc3_win_gfl,      ind_tc3_win_agfl,      &
4288                                              surf_usm_v(l)%ground_level(m) )
4289                    ind_thick_1      = MERGE( ind_thick_1_gfl,      ind_thick_1_agfl,      &
4290                                              surf_usm_v(l)%ground_level(m) )
4291                    ind_thick_1_win  = MERGE( ind_thick_1_win_gfl,  ind_thick_1_win_agfl,  &
4292                                              surf_usm_v(l)%ground_level(m) )
4293                    ind_thick_2      = MERGE( ind_thick_2_gfl,      ind_thick_2_agfl,      &
4294                                              surf_usm_v(l)%ground_level(m) )
4295                    ind_thick_2_win  = MERGE( ind_thick_2_win_gfl,  ind_thick_2_win_agfl,  &
4296                                              surf_usm_v(l)%ground_level(m) )
4297                    ind_thick_3      = MERGE( ind_thick_3_gfl,      ind_thick_3_agfl,      &
4298                                              surf_usm_v(l)%ground_level(m) )
4299                    ind_thick_3_win  = MERGE( ind_thick_3_win_gfl,  ind_thick_3_win_agfl,  &
4300                                              surf_usm_v(l)%ground_level(m) )
4301                    ind_thick_4      = MERGE( ind_thick_4_gfl,      ind_thick_4_agfl,      &
4302                                              surf_usm_v(l)%ground_level(m) )
4303                    ind_thick_4_win  = MERGE( ind_thick_4_win_gfl,  ind_thick_4_win_agfl,  &
4304                                              surf_usm_v(l)%ground_level(m) )
4305                    ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
4306                                              surf_usm_v(l)%ground_level(m) )
4307                    ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
4308                                              surf_usm_v(l)%ground_level(m) )
4309                    ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
4310                                              surf_usm_v(l)%ground_level(m) )
4311                    ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
4312                                            surf_usm_v(l)%ground_level(m) )
4313                    ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
4314                                              surf_usm_v(l)%ground_level(m) )
4315                    ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
4316                                              surf_usm_v(l)%ground_level(m) )
4317!
4318!--                 Store building type and its name on each surface element
4319                    surf_usm_v(l)%building_type(m)      = st
4320                    surf_usm_v(l)%building_type_name(m) = building_type_name(st)
4321!
4322!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
4323                    surf_usm_v(l)%frac(ind_veg_wall,m)  = building_pars(ind_wall_frac,st)   
4324                    surf_usm_v(l)%frac(ind_pav_green,m) = building_pars(ind_green_frac_w,st) 
4325                    surf_usm_v(l)%frac(ind_wat_win,m)   = building_pars(ind_win_frac,st)   
4326                    surf_usm_v(l)%lai(m)                = building_pars(ind_lai_w,st) 
4327
4328                    surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st) 
4329                    surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
4330                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
4331                    surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
4332                   
4333                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   = rho_c_soil !building_pars(ind_hc1,st) 
4334                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = rho_c_soil !building_pars(ind_hc1,st)
4335                    surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = rho_c_soil !building_pars(ind_hc2,st)
4336                    surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = rho_c_soil !building_pars(ind_hc3,st)
4337                   
4338                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1_win,st) 
4339                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1_win,st)
4340                    surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2_win,st)
4341                    surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3_win,st)
4342
4343                    surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st) 
4344                    surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st) 
4345                    surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
4346                    surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st) 
4347                   
4348                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = lambda_h_green_sm !building_pars(ind_tc1,st) 
4349                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = lambda_h_green_sm !building_pars(ind_tc1,st)
4350                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = lambda_h_green_sm !building_pars(ind_tc2,st)
4351                    surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = lambda_h_green_sm !building_pars(ind_tc3,st)
4352                   
4353                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1_win,st) 
4354                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1_win,st) 
4355                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2_win,st)
4356                    surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3_win,st) 
4357
4358                    surf_usm_v(l)%target_temp_summer(m)  = building_pars(ind_indoor_target_temp_summer,st)   
4359                    surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)   
4360!
4361!--                 emissivity of wall-, green- and window fraction
4362                    surf_usm_v(l)%emissivity(ind_veg_wall,m)  = building_pars(ind_emis_wall,st)
4363                    surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,st)
4364                    surf_usm_v(l)%emissivity(ind_wat_win,m)   = building_pars(ind_emis_win,st)
4365
4366                    surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,st)
4367
4368                    surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,st)
4369                    surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,st)
4370                    surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,st)
4371
4372                    surf_usm_v(l)%albedo_type(ind_veg_wall,m)  = INT( building_pars(ind_alb_wall,st) )
4373                    surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,st) )
4374                    surf_usm_v(l)%albedo_type(ind_wat_win,m)   = INT( building_pars(ind_alb_win,st) )
4375
4376                    surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,st)
4377                    surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
4378                    surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
4379                    surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
4380                   
4381                    surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,st)
4382                    surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
4383                    surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
4384                    surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
4385                   
4386                    surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1_win,st)
4387                    surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2_win,st)
4388                    surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3_win,st)
4389                    surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4_win,st)
4390
4391                    surf_usm_v(l)%c_surface(m)           = building_pars(ind_c_surface,st) 
4392                    surf_usm_v(l)%lambda_surf(m)         = building_pars(ind_lambda_surf,st) 
4393                    surf_usm_v(l)%c_surface_green(m)     = building_pars(ind_c_surface_green,st) 
4394                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars(ind_lambda_surf_green,st) 
4395                    surf_usm_v(l)%c_surface_window(m)    = building_pars(ind_c_surface_win,st) 
4396                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars(ind_lambda_surf_win,st) 
4397
4398
4399                 ENDIF
4400              ENDDO
4401           ENDDO
4402        ENDIF 
4403       
4404!
4405!--     Level 3 - initialization via building_pars read from file. Note, only
4406!--     variables that are also defined in the input-standard can be initialized
4407!--     via file. Other variables will be initialized on level 1 or 2.
4408        IF ( building_pars_f%from_file )  THEN
4409           DO  m = 1, surf_usm_h%ns
4410              i = surf_usm_h%i(m)
4411              j = surf_usm_h%j(m)
4412
4413!
4414!--           In order to distinguish between ground floor level and
4415!--           above-ground-floor level surfaces, set input indices.
4416              ind_wall_frac    = MERGE( ind_wall_frac_gfl,                     &
4417                                        ind_wall_frac_agfl,                    &
4418                                        surf_usm_h%ground_level(m) )
4419              ind_green_frac_r = MERGE( ind_green_frac_r_gfl,                  &
4420                                        ind_green_frac_r_agfl,                 &
4421                                        surf_usm_h%ground_level(m) )
4422              ind_win_frac     = MERGE( ind_win_frac_gfl,                      &
4423                                        ind_win_frac_agfl,                     &
4424                                        surf_usm_h%ground_level(m) )
4425              ind_lai_r        = MERGE( ind_lai_r_gfl,                         &
4426                                        ind_lai_r_agfl,                        &
4427                                        surf_usm_h%ground_level(m) )
4428              ind_z0           = MERGE( ind_z0_gfl,                            &
4429                                        ind_z0_agfl,                           &
4430                                        surf_usm_h%ground_level(m) )
4431              ind_z0qh         = MERGE( ind_z0qh_gfl,                          &
4432                                        ind_z0qh_agfl,                         &
4433                                        surf_usm_h%ground_level(m) )
4434              ind_hc1          = MERGE( ind_hc1_gfl,                           &
4435                                        ind_hc1_agfl,                          &
4436                                        surf_usm_h%ground_level(m) )
4437              ind_hc2          = MERGE( ind_hc2_gfl,                           &
4438                                        ind_hc2_agfl,                          &
4439                                        surf_usm_h%ground_level(m) )
4440              ind_hc3          = MERGE( ind_hc3_gfl,                           &
4441                                        ind_hc3_agfl,                          &
4442                                        surf_usm_h%ground_level(m) )
4443              ind_tc1          = MERGE( ind_tc1_gfl,                           &
4444                                        ind_tc1_agfl,                          &
4445                                        surf_usm_h%ground_level(m) )
4446              ind_tc2          = MERGE( ind_tc2_gfl,                           &
4447                                        ind_tc2_agfl,                          &
4448                                        surf_usm_h%ground_level(m) )
4449              ind_tc3          = MERGE( ind_tc3_gfl,                           &
4450                                        ind_tc3_agfl,                          &
4451                                        surf_usm_h%ground_level(m) )
4452              ind_emis_wall    = MERGE( ind_emis_wall_gfl,                     &
4453                                        ind_emis_wall_agfl,                    &
4454                                        surf_usm_h%ground_level(m) )
4455              ind_emis_green   = MERGE( ind_emis_green_gfl,                    &
4456                                        ind_emis_green_agfl,                   &
4457                                        surf_usm_h%ground_level(m) )
4458              ind_emis_win     = MERGE( ind_emis_win_gfl,                      &
4459                                        ind_emis_win_agfl,                     &
4460                                        surf_usm_h%ground_level(m) )
4461              ind_trans        = MERGE( ind_trans_gfl,                         &
4462                                        ind_trans_agfl,                        &
4463                                        surf_usm_h%ground_level(m) )
4464
4465!
4466!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
4467              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /=               &
4468                   building_pars_f%fill )                                      &
4469                 surf_usm_h%frac(ind_veg_wall,m)  =                            &
4470                                    building_pars_f%pars_xy(ind_wall_frac,j,i)   
4471                 
4472              IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /=            &         
4473                   building_pars_f%fill )                                      & 
4474                 surf_usm_h%frac(ind_pav_green,m) =                            &
4475                                    building_pars_f%pars_xy(ind_green_frac_r,j,i) 
4476                 
4477              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /=                &
4478                   building_pars_f%fill )                                      & 
4479                 surf_usm_h%frac(ind_wat_win,m)   =                            &
4480                                    building_pars_f%pars_xy(ind_win_frac,j,i)
4481 
4482              IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /=                   &
4483                   building_pars_f%fill )                                      &
4484                 surf_usm_h%lai(m)  = building_pars_f%pars_xy(ind_lai_r,j,i)
4485
4486              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4487                   building_pars_f%fill )  THEN
4488                 surf_usm_h%rho_c_wall(nzb_wall,m)   =                         &
4489                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4490                 surf_usm_h%rho_c_wall(nzb_wall+1,m) =                         &
4491                                    building_pars_f%pars_xy(ind_hc1,j,i)
4492              ENDIF
4493             
4494             
4495              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4496                   building_pars_f%fill )                                      &
4497                 surf_usm_h%rho_c_wall(nzb_wall+2,m) =                         &
4498                                    building_pars_f%pars_xy(ind_hc2,j,i)
4499                 
4500              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4501                   building_pars_f%fill )                                      &
4502                 surf_usm_h%rho_c_wall(nzb_wall+3,m) =                         &
4503                                    building_pars_f%pars_xy(ind_hc3,j,i)
4504                 
4505              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4506                   building_pars_f%fill )  THEN
4507                 surf_usm_h%rho_c_green(nzb_wall,m)   =                        &
4508                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4509                 surf_usm_h%rho_c_green(nzb_wall+1,m) =                        &
4510                                    building_pars_f%pars_xy(ind_hc1,j,i)
4511              ENDIF
4512              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4513                   building_pars_f%fill )                                      &
4514                 surf_usm_h%rho_c_green(nzb_wall+2,m) =                        &
4515                                    building_pars_f%pars_xy(ind_hc2,j,i)
4516                 
4517              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4518                   building_pars_f%fill )                                      &
4519                 surf_usm_h%rho_c_green(nzb_wall+3,m) =                        &
4520                                    building_pars_f%pars_xy(ind_hc3,j,i)
4521                 
4522              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=                     &
4523                   building_pars_f%fill )  THEN
4524                 surf_usm_h%rho_c_window(nzb_wall,m)   =                       &
4525                                    building_pars_f%pars_xy(ind_hc1,j,i) 
4526                 surf_usm_h%rho_c_window(nzb_wall+1,m) =                       &
4527                                    building_pars_f%pars_xy(ind_hc1,j,i)
4528              ENDIF
4529              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=                     &
4530                   building_pars_f%fill )                                      &
4531                 surf_usm_h%rho_c_window(nzb_wall+2,m) =                       &
4532                                    building_pars_f%pars_xy(ind_hc2,j,i)
4533                 
4534              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=                     &
4535                   building_pars_f%fill )                                      &
4536                 surf_usm_h%rho_c_window(nzb_wall+3,m) =                       &
4537                                    building_pars_f%pars_xy(ind_hc3,j,i)
4538
4539              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=                     &
4540                   building_pars_f%fill )  THEN
4541                 surf_usm_h%lambda_h(nzb_wall,m)   =                           &
4542                                    building_pars_f%pars_xy(ind_tc1,j,i)         
4543                 surf_usm_h%lambda_h(nzb_wall+1,m) =                           &
4544                                    building_pars_f%pars_xy(ind_tc1,j,i)       
4545              ENDIF
4546              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     & 
4547                   building_pars_f%fill )                                      &
4548                 surf_usm_h%lambda_h(nzb_wall+2,m) =                           &
4549                                    building_pars_f%pars_xy(ind_tc2,j,i)
4550                 
4551              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &
4552                   building_pars_f%fill )                                      & 
4553                 surf_usm_h%lambda_h(nzb_wall+3,m) =                           &
4554                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4555                 
4556              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=                     &
4557                   building_pars_f%fill )  THEN
4558                 surf_usm_h%lambda_h_green(nzb_wall,m)   =                     &
4559                                     building_pars_f%pars_xy(ind_tc1,j,i)         
4560                 surf_usm_h%lambda_h_green(nzb_wall+1,m) =                     &
4561                                     building_pars_f%pars_xy(ind_tc1,j,i)       
4562              ENDIF
4563              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     & 
4564                   building_pars_f%fill )                                      &
4565                 surf_usm_h%lambda_h_green(nzb_wall+2,m) =                     &
4566                                    building_pars_f%pars_xy(ind_tc2,j,i)
4567                 
4568              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &       
4569                   building_pars_f%fill )                                      &
4570                 surf_usm_h%lambda_h_green(nzb_wall+3,m) =                     &
4571                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4572                 
4573              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=                     &
4574                   building_pars_f%fill )  THEN
4575                 surf_usm_h%lambda_h_window(nzb_wall,m)   =                    &
4576                                     building_pars_f%pars_xy(ind_tc1,j,i)         
4577                 surf_usm_h%lambda_h_window(nzb_wall+1,m) =                    &
4578                                     building_pars_f%pars_xy(ind_tc1,j,i)       
4579              ENDIF
4580              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=                     &     
4581                   building_pars_f%fill )                                      &
4582                 surf_usm_h%lambda_h_window(nzb_wall+2,m) =                    &
4583                                     building_pars_f%pars_xy(ind_tc2,j,i)
4584                 
4585              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=                     &   
4586                   building_pars_f%fill )                                      &
4587                 surf_usm_h%lambda_h_window(nzb_wall+3,m) =                    &
4588                                    building_pars_f%pars_xy(ind_tc3,j,i)   
4589
4590              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=&           
4591                   building_pars_f%fill )                                      & 
4592                 surf_usm_h%target_temp_summer(m)  =                           &
4593                      building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)   
4594              IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=&           
4595                   building_pars_f%fill )                                      & 
4596                 surf_usm_h%target_temp_winter(m)  =                           &
4597                      building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)   
4598
4599              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /=               &   
4600                   building_pars_f%fill )                                      &
4601                 surf_usm_h%emissivity(ind_veg_wall,m)  =                      &
4602                                    building_pars_f%pars_xy(ind_emis_wall,j,i)
4603                 
4604              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /=              &           
4605                   building_pars_f%fill )                                      &
4606                 surf_usm_h%emissivity(ind_pav_green,m) =                      &
4607                                     building_pars_f%pars_xy(ind_emis_green,j,i)
4608                 
4609              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /=                & 
4610                   building_pars_f%fill )                                      &
4611                 surf_usm_h%emissivity(ind_wat_win,m)   =                      &
4612                                     building_pars_f%pars_xy(ind_emis_win,j,i)
4613                 
4614              IF ( building_pars_f%pars_xy(ind_trans,j,i) /=                   &   
4615                   building_pars_f%fill )                                      &
4616                 surf_usm_h%transmissivity(m) =                                &
4617                                    building_pars_f%pars_xy(ind_trans,j,i)
4618
4619              IF ( building_pars_f%pars_xy(ind_z0,j,i) /=                      &         
4620                   building_pars_f%fill )                                      &
4621                 surf_usm_h%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4622                 
4623              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=                    &           
4624                   building_pars_f%fill )                                      &
4625                 surf_usm_h%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4626              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=                    &           
4627                   building_pars_f%fill )                                      &
4628                 surf_usm_h%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4629
4630              IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /=           &         
4631                   building_pars_f%fill )                                      & 
4632                 surf_usm_h%albedo_type(ind_veg_wall,m)  =                     &
4633                                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4634                 
4635              IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /=          &           
4636                   building_pars_f%fill )                                      &
4637                 surf_usm_h%albedo_type(ind_pav_green,m) =                     &
4638                                building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4639              IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /=            &         
4640                   building_pars_f%fill )                                      &
4641                 surf_usm_h%albedo_type(ind_wat_win,m)   =                     &
4642                                   building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4643
4644              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=            &         
4645                   building_pars_f%fill )                                      & 
4646                 surf_usm_h%zw(nzb_wall,m) =                                   &
4647                                  building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4648                 
4649              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=            &         
4650                   building_pars_f%fill )                                      &
4651                 surf_usm_h%zw(nzb_wall+1,m) =                                 &
4652                                  building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4653                 
4654              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=            &         
4655                   building_pars_f%fill )                                      &
4656                 surf_usm_h%zw(nzb_wall+2,m) =                                 &
4657                                  building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4658                 
4659                 
4660              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=            &         
4661                   building_pars_f%fill )                                      & 
4662                 surf_usm_h%zw(nzb_wall+3,m) =                                 &
4663                                  building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4664                 
4665              IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=            &           
4666                   building_pars_f%fill )                                      &
4667                 surf_usm_h%zw_green(nzb_wall,m) =                             &
4668                                  building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4669                 
4670              IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=            &         
4671                   building_pars_f%fill )                                      &
4672                 surf_usm_h%zw_green(nzb_wall+1,m) =                           &
4673                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4674                 
4675              IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=            &         
4676                   building_pars_f%fill )                                      & 
4677                 surf_usm_h%zw_green(nzb_wall+2,m) =                           &
4678                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4679                 
4680              IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=            &         
4681                   building_pars_f%fill )                                      &
4682                 surf_usm_h%zw_green(nzb_wall+3,m) =                           &
4683                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4684
4685              IF ( building_pars_f%pars_xy(ind_c_surface,j,i) /=               &       
4686                   building_pars_f%fill )                                      & 
4687                 surf_usm_h%c_surface(m) =                                     &
4688                                    building_pars_f%pars_xy(ind_c_surface,j,i)
4689                 
4690              IF ( building_pars_f%pars_xy(ind_lambda_surf,j,i) /=             &       
4691                   building_pars_f%fill )                                      &
4692                 surf_usm_h%lambda_surf(m) =                                   &
4693                                    building_pars_f%pars_xy(ind_lambda_surf,j,i)
4694             
4695           ENDDO
4696
4697
4698
4699           DO  l = 0, 3
4700              DO  m = 1, surf_usm_v(l)%ns
4701                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4702                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4703               
4704!
4705!--                 In order to distinguish between ground floor level and
4706!--                 above-ground-floor level surfaces, set input indices.
4707                    ind_wall_frac    = MERGE( ind_wall_frac_gfl,               &
4708                                              ind_wall_frac_agfl,              &
4709                                              surf_usm_v(l)%ground_level(m) )
4710                    ind_green_frac_w = MERGE( ind_green_frac_w_gfl,            &
4711                                              ind_green_frac_w_agfl,           &
4712                                              surf_usm_v(l)%ground_level(m) )
4713                    ind_win_frac     = MERGE( ind_win_frac_gfl,                &
4714                                              ind_win_frac_agfl,               &
4715                                              surf_usm_v(l)%ground_level(m) )
4716                    ind_lai_w        = MERGE( ind_lai_w_gfl,                   &
4717                                              ind_lai_w_agfl,                  &
4718                                              surf_usm_v(l)%ground_level(m) )
4719                    ind_z0           = MERGE( ind_z0_gfl,                      &
4720                                              ind_z0_agfl,                     &
4721                                              surf_usm_v(l)%ground_level(m) )
4722                    ind_z0qh         = MERGE( ind_z0qh_gfl,                    &
4723                                              ind_z0qh_agfl,                   &
4724                                              surf_usm_v(l)%ground_level(m) )
4725                    ind_hc1          = MERGE( ind_hc1_gfl,                     &
4726                                              ind_hc1_agfl,                    &
4727                                              surf_usm_v(l)%ground_level(m) )
4728                    ind_hc2          = MERGE( ind_hc2_gfl,                     &
4729                                              ind_hc2_agfl,                    &
4730                                              surf_usm_v(l)%ground_level(m) )
4731                    ind_hc3          = MERGE( ind_hc3_gfl,                     &
4732                                              ind_hc3_agfl,                    &
4733                                              surf_usm_v(l)%ground_level(m) )
4734                    ind_tc1          = MERGE( ind_tc1_gfl,                     &
4735                                              ind_tc1_agfl,                    &
4736                                              surf_usm_v(l)%ground_level(m) )
4737                    ind_tc2          = MERGE( ind_tc2_gfl,                     &
4738                                              ind_tc2_agfl,                    &
4739                                              surf_usm_v(l)%ground_level(m) )
4740                    ind_tc3          = MERGE( ind_tc3_gfl,                     &
4741                                              ind_tc3_agfl,                    &
4742                                              surf_usm_v(l)%ground_level(m) )
4743                    ind_emis_wall    = MERGE( ind_emis_wall_gfl,               &
4744                                              ind_emis_wall_agfl,              &
4745                                              surf_usm_v(l)%ground_level(m) )
4746                    ind_emis_green   = MERGE( ind_emis_green_gfl,              &
4747                                              ind_emis_green_agfl,             &
4748                                              surf_usm_v(l)%ground_level(m) )
4749                    ind_emis_win     = MERGE( ind_emis_win_gfl,                &
4750                                              ind_emis_win_agfl,               &
4751                                              surf_usm_v(l)%ground_level(m) )
4752                    ind_trans        = MERGE( ind_trans_gfl,                   &
4753                                              ind_trans_agfl,                  &
4754                                              surf_usm_v(l)%ground_level(m) )
4755                   
4756!                   
4757!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
4758                    IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /=         &
4759                         building_pars_f%fill )                                &
4760                       surf_usm_v(l)%frac(ind_veg_wall,m)  =                   &
4761                                          building_pars_f%pars_xy(ind_wall_frac,j,i)   
4762                       
4763                    IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /=      &         
4764                         building_pars_f%fill )                                & 
4765                       surf_usm_v(l)%frac(ind_pav_green,m) =                   &
4766                                  building_pars_f%pars_xy(ind_green_frac_w,j,i) 
4767                       
4768                    IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /=          &
4769                         building_pars_f%fill )                                & 
4770                       surf_usm_v(l)%frac(ind_wat_win,m)   =                   &
4771                                       building_pars_f%pars_xy(ind_win_frac,j,i)
4772                   
4773                    IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /=             &
4774                         building_pars_f%fill )                                &
4775                       surf_usm_v(l)%lai(m)  =                                 &
4776                                       building_pars_f%pars_xy(ind_lai_w,j,i)
4777                   
4778                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4779                         building_pars_f%fill )  THEN
4780                       surf_usm_v(l)%rho_c_wall(nzb_wall,m)   =                &
4781                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4782                       surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) =                &
4783                                          building_pars_f%pars_xy(ind_hc1,j,i)
4784                    ENDIF
4785                   
4786                   
4787                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4788                         building_pars_f%fill )                                &
4789                       surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) =                &
4790                                          building_pars_f%pars_xy(ind_hc2,j,i)
4791                       
4792                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &         
4793                         building_pars_f%fill )                                &
4794                       surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) =                &
4795                                          building_pars_f%pars_xy(ind_hc3,j,i)
4796                       
4797                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4798                         building_pars_f%fill )  THEN
4799                       surf_usm_v(l)%rho_c_green(nzb_wall,m)   =               &
4800                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4801                       surf_usm_v(l)%rho_c_green(nzb_wall+1,m) =               &
4802                                          building_pars_f%pars_xy(ind_hc1,j,i)
4803                    ENDIF
4804                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4805                         building_pars_f%fill )                                &
4806                       surf_usm_v(l)%rho_c_green(nzb_wall+2,m) =               &
4807                                          building_pars_f%pars_xy(ind_hc2,j,i)
4808                       
4809                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &
4810                         building_pars_f%fill )                                &
4811                       surf_usm_v(l)%rho_c_green(nzb_wall+3,m) =               &
4812                                          building_pars_f%pars_xy(ind_hc3,j,i)
4813                       
4814                    IF ( building_pars_f%pars_xy(ind_hc1,j,i) /=               &
4815                         building_pars_f%fill )  THEN
4816                       surf_usm_v(l)%rho_c_window(nzb_wall,m)   =              &
4817                                          building_pars_f%pars_xy(ind_hc1,j,i) 
4818                       surf_usm_v(l)%rho_c_window(nzb_wall+1,m) =              &
4819                                          building_pars_f%pars_xy(ind_hc1,j,i)
4820                    ENDIF
4821                    IF ( building_pars_f%pars_xy(ind_hc2,j,i) /=               &
4822                         building_pars_f%fill )                                &
4823                       surf_usm_v(l)%rho_c_window(nzb_wall+2,m) =              &
4824                                          building_pars_f%pars_xy(ind_hc2,j,i)
4825                       
4826                    IF ( building_pars_f%pars_xy(ind_hc3,j,i) /=               &
4827                         building_pars_f%fill )                                &
4828                       surf_usm_v(l)%rho_c_window(nzb_wall+3,m) =              &
4829                                          building_pars_f%pars_xy(ind_hc3,j,i)
4830                   
4831                    IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=               &
4832                         building_pars_f%fill )  THEN
4833                       surf_usm_v(l)%lambda_h(nzb_wall,m)   =                  &
4834                                          building_pars_f%pars_xy(ind_tc1,j,i)   
4835                       surf_usm_v(l)%lambda_h(nzb_wall+1,m) =                  &
4836                                          building_pars_f%pars_xy(ind_tc1,j,i) 
4837                    ENDIF
4838                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               & 
4839                         building_pars_f%fill )                                &
4840                       surf_usm_v(l)%lambda_h(nzb_wall+2,m) =                  &
4841                                          building_pars_f%pars_xy(ind_tc2,j,i)
4842                       
4843                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &
4844                         building_pars_f%fill )                                & 
4845                       surf_usm_v(l)%lambda_h(nzb_wall+3,m) =                  &
4846                                          building_pars_f%pars_xy(ind_tc3,j,i) 
4847                       
4848                    IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=               &
4849                         building_pars_f%fill )  THEN
4850                       surf_usm_v(l)%lambda_h_green(nzb_wall,m)   =            &
4851                                           building_pars_f%pars_xy(ind_tc1,j,i)   
4852                       surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) =            &
4853                                           building_pars_f%pars_xy(ind_tc1,j,i) 
4854                    ENDIF
4855                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               & 
4856                         building_pars_f%fill )                                &
4857                       surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) =            &
4858                                          building_pars_f%pars_xy(ind_tc2,j,i)
4859                       
4860                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &       
4861                         building_pars_f%fill )                                &
4862                       surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) =            &
4863                                          building_pars_f%pars_xy(ind_tc3,j,i) 
4864                       
4865                    IF ( building_pars_f%pars_xy(ind_tc1,j,i) /=         &
4866                         building_pars_f%fill )  THEN
4867                       surf_usm_v(l)%lambda_h_window(nzb_wall,m)   =           &
4868                                     building_pars_f%pars_xy(ind_tc1,j,i)         
4869                       surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) =           &
4870                                     building_pars_f%pars_xy(ind_tc1,j,i)       
4871                    ENDIF
4872                    IF ( building_pars_f%pars_xy(ind_tc2,j,i) /=               &     
4873                         building_pars_f%fill )                                &
4874                       surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) =           &
4875                                           building_pars_f%pars_xy(ind_tc2,j,i)
4876                       
4877                    IF ( building_pars_f%pars_xy(ind_tc3,j,i) /=               &   
4878                         building_pars_f%fill )                                &
4879                       surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) =           &
4880                                          building_pars_f%pars_xy(ind_tc3,j,i)   
4881                   
4882                    IF ( building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i) /=&           
4883                         building_pars_f%fill )                                & 
4884                       surf_usm_v(l)%target_temp_summer(m)  =                  &
4885                            building_pars_f%pars_xy(ind_indoor_target_temp_summer,j,i)   
4886                    IF ( building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i) /=&           
4887                         building_pars_f%fill )                                & 
4888                       surf_usm_v(l)%target_temp_winter(m)  =                  &
4889                            building_pars_f%pars_xy(ind_indoor_target_temp_winter,j,i)   
4890                   
4891                    IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /=         &   
4892                         building_pars_f%fill )                                &
4893                       surf_usm_v(l)%emissivity(ind_veg_wall,m)  =             &
4894                                      building_pars_f%pars_xy(ind_emis_wall,j,i)
4895                       
4896                    IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /=        &           
4897                         building_pars_f%fill )                                &
4898                       surf_usm_v(l)%emissivity(ind_pav_green,m) =             &
4899                                      building_pars_f%pars_xy(ind_emis_green,j,i)
4900                       
4901                    IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /=          & 
4902                         building_pars_f%fill )                                &
4903                       surf_usm_v(l)%emissivity(ind_wat_win,m)   =             &
4904                                      building_pars_f%pars_xy(ind_emis_win,j,i)
4905                       
4906                    IF ( building_pars_f%pars_xy(ind_trans,j,i) /=             &   
4907                         building_pars_f%fill )                                &
4908                       surf_usm_v(l)%transmissivity(m) =                       &
4909                                          building_pars_f%pars_xy(ind_trans,j,i)
4910                   
4911                    IF ( building_pars_f%pars_xy(ind_z0,j,i) /=                &         
4912                         building_pars_f%fill )                                &
4913                       surf_usm_v(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4914                       
4915                    IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=              &           
4916                         building_pars_f%fill )                                &
4917                       surf_usm_v(l)%z0h(m) =                                  &
4918                                       building_pars_f%pars_xy(ind_z0qh,j,i)
4919                    IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /=              &           
4920                         building_pars_f%fill )                                &
4921                       surf_usm_v(l)%z0q(m) =                                  &
4922                                       building_pars_f%pars_xy(ind_z0qh,j,i)
4923                   
4924                    IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /=     &         
4925                         building_pars_f%fill )                                & 
4926                       surf_usm_v(l)%albedo_type(ind_veg_wall,m)  =            &
4927                                 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i)
4928                       
4929                    IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /=    &           
4930                         building_pars_f%fill )                                &
4931                       surf_usm_v(l)%albedo_type(ind_pav_green,m) =            &
4932                                 building_pars_f%pars_xy(ind_alb_green_agfl,j,i)
4933                    IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /=      &         
4934                         building_pars_f%fill )                                &
4935                       surf_usm_v(l)%albedo_type(ind_wat_win,m)   =            &
4936                                   building_pars_f%pars_xy(ind_alb_win_agfl,j,i)
4937                   
4938                    IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=      &         
4939                         building_pars_f%fill )                                & 
4940                       surf_usm_v(l)%zw(nzb_wall,m) =                          &
4941                                   building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4942                       
4943                    IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=      &         
4944                         building_pars_f%fill )                                &
4945                       surf_usm_v(l)%zw(nzb_wall+1,m) =                        &
4946                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4947                       
4948                    IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=      &         
4949                         building_pars_f%fill )                                &
4950                       surf_usm_v(l)%zw(nzb_wall+2,m) =                        &
4951                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4952                       
4953                       
4954                    IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=      &         
4955                         building_pars_f%fill )                                & 
4956                       surf_usm_v(l)%zw(nzb_wall+3,m) =                        &
4957                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4958                       
4959                    IF ( building_pars_f%pars_xy(ind_thick_1_agfl,j,i) /=      &           
4960                         building_pars_f%fill )                                &
4961                       surf_usm_v(l)%zw_green(nzb_wall,m) =                    &
4962                                   building_pars_f%pars_xy(ind_thick_1_agfl,j,i)
4963                       
4964                    IF ( building_pars_f%pars_xy(ind_thick_2_agfl,j,i) /=      &         
4965                         building_pars_f%fill )                                &
4966                       surf_usm_v(l)%zw_green(nzb_wall+1,m) =                  &
4967                                   building_pars_f%pars_xy(ind_thick_2_agfl,j,i)
4968                       
4969                    IF ( building_pars_f%pars_xy(ind_thick_3_agfl,j,i) /=      &         
4970                         building_pars_f%fill )                                & 
4971                       surf_usm_v(l)%zw_green(nzb_wall+2,m) =                  &
4972                                   building_pars_f%pars_xy(ind_thick_3_agfl,j,i)
4973                       
4974                    IF ( building_pars_f%pars_xy(ind_thick_4_agfl,j,i) /=      &         
4975                         building_pars_f%fill )                                &
4976                       surf_usm_v(l)%zw_green(nzb_wall+3,m) =                  &
4977                                   building_pars_f%pars_xy(ind_thick_4_agfl,j,i)
4978                   
4979                    IF ( building_pars_f%pars_xy(ind_c_surface,j,i) /=         &       
4980                         building_pars_f%fill )                                & 
4981                       surf_usm_v(l)%c_surface(m) =                            &
4982                                     building_pars_f%pars_xy(ind_c_surface,j,i)
4983                       
4984                    IF ( building_pars_f%pars_xy(ind_lambda_surf,j,i) /=       &       
4985                         building_pars_f%fill )                                &
4986                       surf_usm_v(l)%lambda_surf(m) =                          &
4987                                    building_pars_f%pars_xy(ind_lambda_surf,j,i)
4988                   
4989              ENDDO
4990           ENDDO
4991        ENDIF 
4992!       
4993!--     Read the surface_types array.
4994!--     Please note, here also initialization of surface attributes is done as
4995!--     long as _urbsurf and _surfpar files are available. Values from above
4996!--     will be overwritten. This might be removed later, but is still in the
4997!--     code to enable compatibility with older model version.
4998        CALL usm_read_urban_surface_types()
4999       
5000        CALL usm_init_material_model()
5001!       
5002!--     init anthropogenic sources of heat
5003        IF ( usm_anthropogenic_heat )  THEN
5004!
5005!--         init anthropogenic sources of heat (from transportation for now)
5006            CALL usm_read_anthropogenic_heat()
5007        ENDIF
5008
5009!
5010!--    Check for consistent initialization.
5011!--    Check if roughness length for momentum, or heat, exceed surface-layer
5012!--    height and decrease local roughness length where necessary.
5013       DO  m = 1, surf_usm_h%ns
5014          IF ( surf_usm_h%z0(m) >= surf_usm_h%z_mo(m) )  THEN
5015         
5016             surf_usm_h%z0(m) = 0.9_wp * surf_usm_h%z_mo(m)
5017             
5018             WRITE( message_string, * ) 'z0 exceeds surface-layer height ' //  &
5019                            'at horizontal urban surface and is ' //           &
5020                            'decreased appropriately at grid point (i,j) = ',  &
5021                            surf_usm_h%i(m), surf_usm_h%j(m)
5022             CALL message( 'urban_surface_model_mod', 'PA0503',                &
5023                            0, 0, 0, 6, 0 )
5024          ENDIF
5025          IF ( surf_usm_h%z0h(m) >= surf_usm_h%z_mo(m) )  THEN
5026         
5027             surf_usm_h%z0h(m) = 0.9_wp * surf_usm_h%z_mo(m)
5028             surf_usm_h%z0q(m) = 0.9_wp * surf_usm_h%z_mo(m)
5029             
5030             WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // &
5031                            'at horizontal urban surface and is ' //           &
5032                            'decreased appropriately at grid point (i,j) = ',  &
5033                            surf_usm_h%i(m), surf_usm_h%j(m)
5034             CALL message( 'urban_surface_model_mod', 'PA0507',                &
5035                            0, 0, 0, 6, 0 )
5036          ENDIF         
5037       ENDDO
5038       
5039       DO  l = 0, 3
5040          DO  m = 1, surf_usm_v(l)%ns
5041             IF ( surf_usm_v(l)%z0(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5042         
5043                surf_usm_v(l)%z0(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5044             
5045                WRITE( message_string, * ) 'z0 exceeds surface-layer height '// &
5046                            'at vertical urban surface and is ' //              &
5047                            'decreased appropriately at grid point (i,j) = ',   &
5048                            surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,              &
5049                            surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5050                CALL message( 'urban_surface_model_mod', 'PA0503',              &
5051                            0, 0, 0, 6, 0 )
5052             ENDIF
5053             IF ( surf_usm_v(l)%z0h(m) >= surf_usm_v(l)%z_mo(m) )  THEN
5054         
5055                surf_usm_v(l)%z0h(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5056                surf_usm_v(l)%z0q(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
5057             
5058                WRITE( message_string, * ) 'z0h exceeds surface-layer height '// &
5059                            'at vertical urban surface and is ' //               &
5060                            'decreased appropriately at grid point (i,j) = ',    &
5061                            surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff,               &
5062                            surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
5063                CALL message( 'urban_surface_model_mod', 'PA0507',               &
5064                            0, 0, 0, 6, 0 )
5065             ENDIF
5066          ENDDO
5067       ENDDO
5068!
5069!--     Intitialization of the surface and wall/ground/roof temperature
5070!
5071!--     Initialization for restart runs
5072        IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.        &
5073             TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
5074
5075!
5076!--         At horizontal surfaces. Please note, t_surf_wall_h is defined on a
5077!--         different data type, but with the same dimension.
5078            DO  m = 1, surf_usm_h%ns
5079               i = surf_usm_h%i(m)           
5080               j = surf_usm_h%j(m)
5081               k = surf_usm_h%k(m)
5082
5083               t_surf_wall_h(m) = pt(k,j,i) * exner(k)
5084               t_surf_window_h(m) = pt(k,j,i) * exner(k)
5085               t_surf_green_h(m) = pt(k,j,i) * exner(k)
5086               surf_usm_h%pt_surface(m) = pt(k,j,i) * exner(k)
5087            ENDDO
5088!
5089!--         At vertical surfaces.
5090            DO  l = 0, 3
5091               DO  m = 1, surf_usm_v(l)%ns
5092                  i = surf_usm_v(l)%i(m)           
5093                  j = surf_usm_v(l)%j(m)
5094                  k = surf_usm_v(l)%k(m)
5095
5096                  t_surf_wall_v(l)%t(m) = pt(k,j,i) * exner(k)
5097                  t_surf_window_v(l)%t(m) = pt(k,j,i) * exner(k)
5098                  t_surf_green_v(l)%t(m) = pt(k,j,i) * exner(k)
5099                  surf_usm_v(l)%pt_surface(m) = pt(k,j,i) * exner(k)
5100               ENDDO
5101            ENDDO
5102
5103!
5104!--         For the sake of correct initialization, set also q_surface.
5105!--         Note, at urban surfaces q_surface is initialized with 0.
5106            IF ( humidity )  THEN
5107               DO  m = 1, surf_usm_h%ns
5108                  surf_usm_h%q_surface(m) = 0.0_wp
5109               ENDDO
5110               DO  l = 0, 3
5111                  DO  m = 1, surf_usm_v(l)%ns
5112                     surf_usm_v(l)%q_surface(m) = 0.0_wp
5113                  ENDDO
5114               ENDDO
5115            ENDIF
5116!
5117!--         initial values for t_wall
5118!--         outer value is set to surface temperature
5119!--         inner value is set to wall_inner_temperature
5120!--         and profile is logaritmic (linear in nz).
5121!--         Horizontal surfaces
5122            DO  m = 1, surf_usm_h%ns
5123!
5124!--            Roof
5125               IF ( surf_usm_h%isroof_surf(m) )  THEN
5126                   tin = roof_inner_temperature
5127                   twin = window_inner_temperature
5128!
5129!--            Normal land surface
5130               ELSE
5131                   tin = soil_inner_temperature
5132                   twin = window_inner_temperature
5133               ENDIF
5134
5135               DO k = nzb_wall, nzt_wall+1
5136                   c = REAL( k - nzb_wall, wp ) /                              &
5137                       REAL( nzt_wall + 1 - nzb_wall , wp )
5138
5139                   t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_wall_h(m) + c * tin
5140                   t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
5141                   t_green_h(k,m) = t_surf_wall_h(m)
5142                   swc_h(k,m) = 0.5_wp
5143                   swc_sat_h(k,m) = 0.95_wp
5144                   swc_res_h(k,m) = 0.05_wp
5145                   rootfr_h(k,m) = 0.1_wp
5146                   wilt_h(k,m) = 0.1_wp
5147                   fc_h(k,m) = 0.9_wp
5148               ENDDO
5149            ENDDO
5150!
5151!--         Vertical surfaces
5152            DO  l = 0, 3
5153               DO  m = 1, surf_usm_v(l)%ns
5154!
5155!--               Inner wall
5156                  tin = wall_inner_temperature
5157                  twin = window_inner_temperature
5158
5159                  DO k = nzb_wall, nzt_wall+1
5160                     c = REAL( k - nzb_wall, wp ) /                            &
5161                         REAL( nzt_wall + 1 - nzb_wall , wp )
5162                     t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_wall_v(l)%t(m) + c * tin
5163                     t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
5164                     t_green_v(l)%t(k,m) = t_surf_wall_v(l)%t(m)
5165                     swc_v(l)%t(k,m) = 0.5_wp
5166                  ENDDO
5167               ENDDO
5168            ENDDO
5169        ENDIF
5170
5171!
5172!--     If specified, replace constant wall temperatures with fully 3D values from file
5173        IF ( read_wall_temp_3d )  CALL usm_read_wall_temperature()
5174
5175!--
5176!--     Possibly DO user-defined actions (e.g. define heterogeneous wall surface)
5177        CALL user_init_urban_surface
5178
5179!
5180!--     initialize prognostic values for the first timestep
5181        t_surf_wall_h_p = t_surf_wall_h
5182        t_surf_wall_v_p = t_surf_wall_v
5183        t_surf_window_h_p = t_surf_window_h
5184        t_surf_window_v_p = t_surf_window_v
5185        t_surf_green_h_p = t_surf_green_h
5186        t_surf_green_v_p = t_surf_green_v
5187
5188        t_wall_h_p = t_wall_h
5189        t_wall_v_p = t_wall_v
5190        t_window_h_p = t_window_h
5191        t_window_v_p = t_window_v
5192        t_green_h_p = t_green_h
5193        t_green_v_p = t_green_v
5194
5195!
5196!--     Adjust radiative fluxes for urban surface at model start
5197        !CALL radiation_interaction
5198!--     TODO: interaction should be called once before first output,
5199!--     that is not yet possible.
5200       
5201        m_liq_usm_h_p     = m_liq_usm_h
5202        m_liq_usm_v_p     = m_liq_usm_v
5203!
5204!--    Set initial values for prognostic quantities
5205!--    Horizontal surfaces
5206       tm_liq_usm_h_m%var_usm_1d  = 0.0_wp
5207       surf_usm_h%c_liq = 0.0_wp
5208
5209       surf_usm_h%qsws_liq  = 0.0_wp
5210       surf_usm_h%qsws_veg  = 0.0_wp
5211
5212!
5213!--    Do the same for vertical surfaces
5214       DO  l = 0, 3
5215          tm_liq_usm_v_m(l)%var_usm_1d  = 0.0_wp
5216          surf_usm_v(l)%c_liq = 0.0_wp
5217
5218          surf_usm_v(l)%qsws_liq  = 0.0_wp
5219          surf_usm_v(l)%qsws_veg  = 0.0_wp
5220       ENDDO
5221
5222!
5223!--    Set initial values for prognostic soil quantities
5224       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
5225          m_liq_usm_h%var_usm_1d  = 0.0_wp
5226
5227          DO  l = 0, 3
5228             m_liq_usm_v(l)%var_usm_1d  = 0.0_wp
5229          ENDDO
5230       ENDIF
5231
5232        CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
5233
5234        IF ( debug_output )  CALL debug_message( 'usm_init', 'end' )
5235
5236    END SUBROUTINE usm_init
5237
5238
5239!------------------------------------------------------------------------------!
5240! Description:
5241! ------------
5242!
5243!> Wall model as part of the urban surface model. The model predicts vertical
5244!> and horizontal wall / roof temperatures and window layer temperatures.
5245!> No window layer temperature calculactions during spinup to increase
5246!> possible timestep.
5247!------------------------------------------------------------------------------!
5248    SUBROUTINE usm_material_heat_model( during_spinup )
5249
5250
5251        IMPLICIT NONE
5252
5253        INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
5254
5255        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend, wintend  !< tendency
5256        REAL(wp)     :: win_absorp  !< absorption coefficient from transmissivity
5257        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wall_mod
5258
5259        LOGICAL      :: during_spinup  !< if true, no calculation of window temperatures
5260
5261
5262        IF ( debug_output_timestep )  THEN
5263           WRITE( debug_string, * ) 'usm_material_heat_model | during_spinup: ',&
5264                                     during_spinup
5265           CALL debug_message( debug_string, 'start' )
5266        ENDIF
5267
5268        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
5269        wall_mod=1.0_wp
5270        IF ( usm_wall_mod  .AND.  during_spinup )  THEN
5271           DO  kw=nzb_wall,nzb_wall+1
5272               wall_mod(kw)=0.1_wp
5273           ENDDO
5274        ENDIF
5275
5276!
5277!--     For horizontal surfaces                                   
5278        !$OMP DO SCHEDULE (STATIC)
5279        DO  m = 1, surf_usm_h%ns
5280!
5281!--        Obtain indices
5282           i = surf_usm_h%i(m)           
5283           j = surf_usm_h%j(m)
5284           k = surf_usm_h%k(m)
5285!
5286!--        prognostic equation for ground/roof temperature t_wall_h
5287           wtend(:) = 0.0_wp
5288           wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *        &
5289                                       ( surf_usm_h%lambda_h(nzb_wall,m) * wall_mod(nzb_wall) *        &
5290                                         ( t_wall_h(nzb_wall+1,m)                  &
5291                                         - t_wall_h(nzb_wall,m) ) *                &
5292                                         surf_usm_h%ddz_wall(nzb_wall+1,m)         &
5293                                       + surf_usm_h%frac(ind_veg_wall,m)           &
5294                                         / (surf_usm_h%frac(ind_veg_wall,m)        &
5295                                           + surf_usm_h%frac(ind_pav_green,m) )    &
5296                                         * surf_usm_h%wghf_eb(m)                   &
5297                                       - surf_usm_h%frac(ind_pav_green,m)          &
5298                                          / (surf_usm_h%frac(ind_veg_wall,m)       &
5299                                            + surf_usm_h%frac(ind_pav_green,m) )   &
5300                                         * ( surf_usm_h%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) &
5301                                           * surf_usm_h%ddz_green(nzt_wall,m)      &
5302                                           + surf_usm_h%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)      &
5303                                           * surf_usm_h%ddz_wall(nzb_wall,m) )     &
5304                                         / ( surf_usm_h%ddz_green(nzt_wall,m)      &
5305                                           + surf_usm_h%ddz_wall(nzb_wall,m) )     &
5306                                         * ( t_wall_h(nzb_wall,m)                  &
5307                                           - t_green_h(nzt_wall,m) ) ) *           &
5308                                       surf_usm_h%ddz_wall_stag(nzb_wall,m)
5309!
5310!-- if indoor model ist used inner wall layer is calculated by using iwghf (indoor wall ground heat flux)
5311           IF ( indoor_model ) THEN
5312              DO  kw = nzb_wall+1, nzt_wall-1
5313                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
5314                                 * (   surf_usm_h%lambda_h(kw,m) * wall_mod(kw)   &
5315                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
5316                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
5317                                 - surf_usm_h%lambda_h(kw-1,m) * wall_mod(kw-1)   &
5318                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
5319                                    * surf_usm_h%ddz_wall(kw,m)                   &
5320                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
5321              ENDDO
5322              wtend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m)) *    &
5323                                         ( -surf_usm_h%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1) * &
5324                                           ( t_wall_h(nzt_wall,m)                 &
5325                                           - t_wall_h(nzt_wall-1,m) ) *           &
5326                                           surf_usm_h%ddz_wall(nzt_wall,m)        &
5327                                         + surf_usm_h%iwghf_eb(m) ) *             &
5328                                           surf_usm_h%ddz_wall_stag(nzt_wall,m)
5329           ELSE
5330              DO  kw = nzb_wall+1, nzt_wall
5331                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
5332                                 * (   surf_usm_h%lambda_h(kw,m)  * wall_mod(kw)  &
5333                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
5334                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
5335                                 - surf_usm_h%lambda_h(kw-1,m) * wall_mod(kw-1)   &
5336                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
5337                                    * surf_usm_h%ddz_wall(kw,m)                   &
5338                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
5339              ENDDO
5340           ENDIF
5341
5342           t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m)     &
5343                                 + dt_3d * ( tsc(2)                            &
5344                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
5345                                 * surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )   
5346
5347!
5348!-- during spinup the tempeature inside window layers is not calculated to make larger timesteps possible
5349           IF ( .NOT. during_spinup ) THEN
5350              win_absorp = -log(surf_usm_h%transmissivity(m)) / surf_usm_h%zw_window(nzt_wall,m)
5351!
5352!--           prognostic equation for ground/roof window temperature t_window_h
5353!--           takes absorption of shortwave radiation into account
5354              wintend(:) = 0.0_wp
5355              wintend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m)) *   &
5356                                         ( surf_usm_h%lambda_h_window(nzb_wall,m) *  &
5357                                           ( t_window_h(nzb_wall+1,m)                &
5358                                           - t_window_h(nzb_wall,m) ) *              &
5359                                           surf_usm_h%ddz_window(nzb_wall+1,m)       &
5360                                         + surf_usm_h%wghf_eb_window(m)              &
5361                                         + surf_usm_h%rad_sw_in(m)                   &
5362                                           * (1.0_wp - exp(-win_absorp               &
5363                                           * surf_usm_h%zw_window(nzb_wall,m) ) )    &
5364                                         ) * surf_usm_h%ddz_window_stag(nzb_wall,m)
5365   
5366              IF ( indoor_model ) THEN
5367                 DO  kw = nzb_wall+1, nzt_wall-1
5368                     wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
5369                                    * (   surf_usm_h%lambda_h_window(kw,m)           &
5370                                       * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
5371                                       * surf_usm_h%ddz_window(kw+1,m)               &
5372                                    - surf_usm_h%lambda_h_window(kw-1,m)             &
5373                                       * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
5374                                       * surf_usm_h%ddz_window(kw,m)                 &
5375                                    + surf_usm_h%rad_sw_in(m)                        &
5376                                       * (exp(-win_absorp                            &
5377                                           * surf_usm_h%zw_window(kw-1,m) )          &
5378                                           - exp(-win_absorp                         &
5379                                           * surf_usm_h%zw_window(kw,m) ) )          &
5380                                      ) * surf_usm_h%ddz_window_stag(kw,m)
5381   
5382                 ENDDO
5383                 wintend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m)) *       &
5384                                            ( -surf_usm_h%lambda_h_window(nzt_wall-1,m) *   &
5385                                              ( t_window_h(nzt_wall,m)                      &
5386                                              - t_window_h(nzt_wall-1,m) ) *                &
5387                                              surf_usm_h%ddz_window(nzt_wall,m)             &
5388                                            + surf_usm_h%iwghf_eb_window(m)                 &
5389                                            + surf_usm_h%rad_sw_in(m)                       &
5390                                              * (exp(-win_absorp                            &
5391                                              * surf_usm_h%zw_window(nzt_wall-1,m) )        &
5392                                              - exp(-win_absorp                             &
5393                                              * surf_usm_h%zw_window(nzt_wall,m) ) )        &
5394                                            ) * surf_usm_h%ddz_window_stag(nzt_wall,m)
5395              ELSE
5396                 DO  kw = nzb_wall+1, nzt_wall
5397                     wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
5398                                    * (   surf_usm_h%lambda_h_window(kw,m)           &
5399                                       * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
5400                                       * surf_usm_h%ddz_window(kw+1,m)               &
5401                                    - surf_usm_h%lambda_h_window(kw-1,m)             &
5402                                       * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
5403                                       * surf_usm_h%ddz_window(kw,m)                 &
5404                                    + surf_usm_h%rad_sw_in(m)                        &
5405                                       * (exp(-win_absorp                            &
5406                                           * surf_usm_h%zw_window(kw-1,m) )          &
5407                                           - exp(-win_absorp                         &
5408                                           * surf_usm_h%zw_window(kw,m) ) )          &
5409                                      ) * surf_usm_h%ddz_window_stag(kw,m)
5410   
5411                 ENDDO
5412              ENDIF
5413
5414              t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m) &
5415                                 + dt_3d * ( tsc(2)                               &
5416                                 * wintend(nzb_wall:nzt_wall) + tsc(3)            &
5417                                 * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )   
5418
5419           ENDIF
5420
5421!
5422!--        calculate t_wall tendencies for the next Runge-Kutta step
5423           IF ( timestep_scheme(1:5) == 'runge' )  THEN
5424               IF ( intermediate_timestep_count == 1 )  THEN
5425                  DO  kw = nzb_wall, nzt_wall
5426                     surf_usm_h%tt_wall_m(kw,m) = wtend(kw)
5427                  ENDDO
5428               ELSEIF ( intermediate_timestep_count <                          &
5429                        intermediate_timestep_count_max )  THEN
5430                   DO  kw = nzb_wall, nzt_wall
5431                      surf_usm_h%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +    &
5432                                         5.3125_wp * surf_usm_h%tt_wall_m(kw,m)
5433                   ENDDO
5434               ENDIF
5435           ENDIF
5436
5437           IF ( .NOT. during_spinup )  THEN
5438!
5439!--           calculate t_window tendencies for the next Runge-Kutta step
5440              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5441                  IF ( intermediate_timestep_count == 1 )  THEN
5442                     DO  kw = nzb_wall, nzt_wall
5443                        surf_usm_h%tt_window_m(kw,m) = wintend(kw)
5444                     ENDDO
5445                  ELSEIF ( intermediate_timestep_count <                            &
5446                           intermediate_timestep_count_max )  THEN
5447                      DO  kw = nzb_wall, nzt_wall
5448                         surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +  &
5449                                            5.3125_wp * surf_usm_h%tt_window_m(kw,m)
5450                      ENDDO
5451                  ENDIF
5452              ENDIF
5453           ENDIF
5454
5455        ENDDO
5456
5457!
5458!--     For vertical surfaces     
5459        !$OMP DO SCHEDULE (STATIC)
5460        DO  l = 0, 3                             
5461           DO  m = 1, surf_usm_v(l)%ns
5462!
5463!--           Obtain indices
5464              i = surf_usm_v(l)%i(m)           
5465              j = surf_usm_v(l)%j(m)
5466              k = surf_usm_v(l)%k(m)
5467!
5468!--           prognostic equation for wall temperature t_wall_v
5469              wtend(:) = 0.0_wp
5470
5471              wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) *    &
5472                                      ( surf_usm_v(l)%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)  *      &
5473                                        ( t_wall_v(l)%t(nzb_wall+1,m)                &
5474                                        - t_wall_v(l)%t(nzb_wall,m) ) *              &
5475                                        surf_usm_v(l)%ddz_wall(nzb_wall+1,m)         &
5476                                      + surf_usm_v(l)%frac(ind_veg_wall,m)           &
5477                                        / (surf_usm_v(l)%frac(ind_veg_wall,m)        &
5478                                          + surf_usm_v(l)%frac(ind_pav_green,m) )    &
5479                                        * surf_usm_v(l)%wghf_eb(m)                   &
5480                                      - surf_usm_v(l)%frac(ind_pav_green,m)          &
5481                                        / (surf_usm_v(l)%frac(ind_veg_wall,m)        &
5482                                          + surf_usm_v(l)%frac(ind_pav_green,m) )    &
5483                                        * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) &
5484                                          * surf_usm_v(l)%ddz_green(nzt_wall,m)      &
5485                                          + surf_usm_v(l)%lambda_h(nzb_wall,m)* wall_mod(nzb_wall)       &
5486                                          * surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
5487                                        / ( surf_usm_v(l)%ddz_green(nzt_wall,m)      &
5488                                          + surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
5489                                        * ( t_wall_v(l)%t(nzb_wall,m)                &
5490                                          - t_green_v(l)%t(nzt_wall,m) ) ) *         &
5491                                        surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
5492
5493              IF ( indoor_model ) THEN
5494                 DO  kw = nzb_wall+1, nzt_wall-1
5495                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
5496                              * (   surf_usm_v(l)%lambda_h(kw,m)  * wall_mod(kw)  &
5497                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5498                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
5499                              - surf_usm_v(l)%lambda_h(kw-1,m)  * wall_mod(kw-1)  &
5500                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5501                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
5502                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5503                 ENDDO
5504                 wtend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m)) * &
5505                                         ( -surf_usm_v(l)%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)*    &
5506                                           ( t_wall_v(l)%t(nzt_wall,m)               &
5507                                           - t_wall_v(l)%t(nzt_wall-1,m) ) *         &
5508                                           surf_usm_v(l)%ddz_wall(nzt_wall,m)        &
5509                                         + surf_usm_v(l)%iwghf_eb(m) ) *             &
5510                                           surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
5511              ELSE
5512                 DO  kw = nzb_wall+1, nzt_wall
5513                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
5514                              * (   surf_usm_v(l)%lambda_h(kw,m) * wall_mod(kw)   &
5515                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5516                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
5517                              - surf_usm_v(l)%lambda_h(kw-1,m)  * wall_mod(kw-1)  &
5518                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5519                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
5520                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5521                 ENDDO
5522              ENDIF
5523
5524              t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
5525                                   t_wall_v(l)%t(nzb_wall:nzt_wall,m)          &
5526                                 + dt_3d * ( tsc(2)                            &
5527                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
5528                                 * surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall,m) )   
5529
5530              IF ( .NOT. during_spinup )  THEN
5531                 win_absorp = -log(surf_usm_v(l)%transmissivity(m)) / surf_usm_v(l)%zw_window(nzt_wall,m)
5532!
5533!--              prognostic equation for window temperature t_window_v
5534                 wintend(:) = 0.0_wp
5535                 wintend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m)) * &
5536                                         ( surf_usm_v(l)%lambda_h_window(nzb_wall,m) *   &
5537                                           ( t_window_v(l)%t(nzb_wall+1,m)               &
5538                                           - t_window_v(l)%t(nzb_wall,m) ) *             &
5539                                           surf_usm_v(l)%ddz_window(nzb_wall+1,m)        &
5540                                         + surf_usm_v(l)%wghf_eb_window(m)               &
5541                                         + surf_usm_v(l)%rad_sw_in(m)                    &
5542                                           * (1.0_wp - exp(-win_absorp                   &
5543                                           * surf_usm_v(l)%zw_window(nzb_wall,m) ) )     &
5544                                         ) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
5545   
5546                 IF ( indoor_model ) THEN
5547                    DO  kw = nzb_wall+1, nzt_wall -1
5548                        wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
5549                                 * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
5550                                    * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5551                                    * surf_usm_v(l)%ddz_window(kw+1,m)                    &
5552                                 - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
5553                                    * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5554                                    * surf_usm_v(l)%ddz_window(kw,m)                      &
5555                                 + surf_usm_v(l)%rad_sw_in(m)                             &
5556                                    * (exp(-win_absorp                                    &
5557                                       * surf_usm_v(l)%zw_window(kw-1,m)       )          &
5558                                           - exp(-win_absorp                              &
5559                                           * surf_usm_v(l)%zw_window(kw,m) ) )            &
5560                                    ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5561                     ENDDO
5562                     wintend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m)) *  &
5563                                             ( -surf_usm_v(l)%lambda_h_window(nzt_wall-1,m) * &
5564                                               ( t_window_v(l)%t(nzt_wall,m)                  &
5565                                               - t_window_v(l)%t(nzt_wall-1,m) ) *            &
5566                                               surf_usm_v(l)%ddz_window(nzt_wall,m)           &
5567                                             + surf_usm_v(l)%iwghf_eb_window(m)               &
5568                                             + surf_usm_v(l)%rad_sw_in(m)                     &
5569                                               * (exp(-win_absorp                             &
5570                                             * surf_usm_v(l)%zw_window(nzt_wall-1,m) )        &
5571                                           - exp(-win_absorp                                  &
5572                                               * surf_usm_v(l)%zw_window(nzt_wall,m) ) )      &
5573                                             ) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
5574                 ELSE
5575                    DO  kw = nzb_wall+1, nzt_wall
5576                        wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
5577                                 * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
5578                                    * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5579                                    * surf_usm_v(l)%ddz_window(kw+1,m)                    &
5580                                 - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
5581                                    * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5582                                    * surf_usm_v(l)%ddz_window(kw,m)                      &
5583                                 + surf_usm_v(l)%rad_sw_in(m)                             &
5584                                    * (exp(-win_absorp                                    &
5585                                       * surf_usm_v(l)%zw_window(kw-1,m)       )          &
5586                                           - exp(-win_absorp                              &
5587                                           * surf_usm_v(l)%zw_window(kw,m) ) )            &
5588                                    ) * surf_usm_v(l)%ddz_window_stag(kw,m)
5589                    ENDDO
5590                 ENDIF
5591   
5592                 t_window_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
5593                                      t_window_v(l)%t(nzb_wall:nzt_wall,m)          &
5594                                    + dt_3d * ( tsc(2)                              &
5595                                    * wintend(nzb_wall:nzt_wall) + tsc(3)           &
5596                                    * surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )   
5597              ENDIF
5598
5599!
5600!--           calculate t_wall tendencies for the next Runge-Kutta step
5601              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5602                  IF ( intermediate_timestep_count == 1 )  THEN
5603                     DO  kw = nzb_wall, nzt_wall
5604                        surf_usm_v(l)%tt_wall_m(kw,m) = wtend(kw)
5605                     ENDDO
5606                  ELSEIF ( intermediate_timestep_count <                       &
5607                           intermediate_timestep_count_max )  THEN
5608                      DO  kw = nzb_wall, nzt_wall
5609                         surf_usm_v(l)%tt_wall_m(kw,m) =                       &
5610                                     - 9.5625_wp * wtend(kw) +                 &
5611                                       5.3125_wp * surf_usm_v(l)%tt_wall_m(kw,m)
5612                      ENDDO
5613                  ENDIF
5614              ENDIF
5615
5616
5617              IF ( .NOT. during_spinup )  THEN
5618!
5619!--              calculate t_window tendencies for the next Runge-Kutta step
5620                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
5621                     IF ( intermediate_timestep_count == 1 )  THEN
5622                        DO  kw = nzb_wall, nzt_wall
5623                           surf_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
5624                        ENDDO
5625                     ELSEIF ( intermediate_timestep_count <                       &
5626                              intermediate_timestep_count_max )  THEN
5627                         DO  kw = nzb_wall, nzt_wall
5628                            surf_usm_v(l)%tt_window_m(kw,m) =                     &
5629                                        - 9.5625_wp * wintend(kw) +               &
5630                                          5.3125_wp * surf_usm_v(l)%tt_window_m(kw,m)
5631                         ENDDO
5632                     ENDIF
5633                 ENDIF
5634              ENDIF
5635
5636           ENDDO
5637        ENDDO
5638        !$OMP END PARALLEL
5639
5640        IF ( debug_output_timestep )  THEN
5641           WRITE( debug_string, * ) 'usm_material_heat_model | during_spinup: ',&
5642                                    during_spinup
5643           CALL debug_message( debug_string, 'end' )
5644        ENDIF
5645
5646    END SUBROUTINE usm_material_heat_model
5647
5648!------------------------------------------------------------------------------!
5649! Description:
5650! ------------
5651!
5652!> Green and substrate model as part of the urban surface model. The model predicts ground
5653!> temperatures.
5654!>
5655!> Important: gree-heat model crashes due to unknown reason. Green fraction
5656!> is thus set to zero (in favor of wall fraction).
5657!------------------------------------------------------------------------------!
5658    SUBROUTINE usm_green_heat_model
5659
5660
5661        IMPLICIT NONE
5662
5663        INTEGER(iwp) ::  i,j,k,l,kw, m              !< running indices
5664
5665        REAL(wp)     :: ke, lambda_h_green_sat      !< heat conductivity for saturated soil
5666        REAL(wp)     :: h_vg                        !< Van Genuchten coef. h
5667        REAL(wp)     :: drho_l_lv                   !< frequently used parameter
5668
5669        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: gtend,tend  !< tendency
5670
5671        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: root_extr_green
5672
5673        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) :: lambda_green_temp  !< temp. lambda
5674        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) :: gamma_green_temp   !< temp. gamma
5675
5676        LOGICAL :: conserve_water_content = .true.
5677
5678
5679        IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'start' )
5680
5681        drho_l_lv = 1.0_wp / (rho_l * l_v)
5682
5683!
5684!--     For horizontal surfaces                                   
5685        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend,  &
5686        !$OMP&                  tend, h_vg, gamma_green_temp, m_total, root_extr_green)
5687        !$OMP DO SCHEDULE (STATIC)
5688        DO  m = 1, surf_usm_h%ns
5689           IF (surf_usm_h%frac(ind_pav_green,m) > 0.0_wp) THEN
5690!
5691!--           Obtain indices
5692              i = surf_usm_h%i(m)           
5693              j = surf_usm_h%j(m)
5694              k = surf_usm_h%k(m)
5695   
5696              DO  kw = nzb_wall, nzt_wall
5697!
5698!--              Calculate volumetric heat capacity of the soil, taking
5699!--              into account water content
5700                 surf_usm_h%rho_c_total_green(kw,m) = (surf_usm_h%rho_c_green(kw,m) * (1.0_wp - swc_sat_h(kw,m)) &
5701                                      + rho_c_water * swc_h(kw,m))
5702     
5703!
5704!--              Calculate soil heat conductivity at the center of the soil
5705!--              layers
5706                 lambda_h_green_sat = lambda_h_green_sm ** (1.0_wp - swc_sat_h(kw,m)) *    &
5707                                lambda_h_water ** swc_h(kw,m)
5708     
5709                 ke = 1.0_wp + LOG10(MAX(0.1_wp,swc_h(kw,m)             &
5710                      / swc_sat_h(kw,m)))
5711     
5712                 lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry) +    &
5713                                  lambda_h_green_dry
5714   
5715              ENDDO
5716              lambda_green_temp(nzt_wall+1) = lambda_green_temp(nzt_wall)
5717   
5718   
5719!
5720!--           Calculate soil heat conductivity (lambda_h) at the _stag level
5721!--           using linear interpolation. For pavement surface, the
5722!--           true pavement depth is considered
5723              DO  kw = nzb_wall, nzt_wall
5724                surf_usm_h%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )  &
5725                                      * 0.5_wp
5726              ENDDO
5727
5728              t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
5729!
5730!--        prognostic equation for ground/roof temperature t_green_h
5731              gtend(:) = 0.0_wp
5732              gtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_total_green(nzb_wall,m)) *    &
5733                                         ( surf_usm_h%lambda_h_green(nzb_wall,m) * &
5734                                           ( t_green_h(nzb_wall+1,m)               &
5735                                           - t_green_h(nzb_wall,m) ) *             &
5736                                           surf_usm_h%ddz_green(nzb_wall+1,m)      &
5737                                         + surf_usm_h%wghf_eb_green(m) ) *         &
5738                                           surf_usm_h%ddz_green_stag(nzb_wall,m)
5739             
5740               DO  kw = nzb_wall+1, nzt_wall
5741                   gtend(kw) = (1.0_wp / surf_usm_h%rho_c_total_green(kw,m))       &
5742                                  * (   surf_usm_h%lambda_h_green(kw,m)            &
5743                                     * ( t_green_h(kw+1,m) - t_green_h(kw,m) )     &
5744                                     * surf_usm_h%ddz_green(kw+1,m)                &
5745                                  - surf_usm_h%lambda_h_green(kw-1,m)              &
5746                                     * ( t_green_h(kw,m) - t_green_h(kw-1,m) )     &
5747                                     * surf_usm_h%ddz_green(kw,m)                  &
5748                                    ) * surf_usm_h%ddz_green_stag(kw,m)
5749               ENDDO
5750   
5751              t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m)    &
5752                                    + dt_3d * ( tsc(2)                             &
5753                                    * gtend(nzb_wall:nzt_wall) + tsc(3)            &
5754                                    * surf_usm_h%tt_green_m(nzb_wall:nzt_wall,m) )   
5755   
5756             
5757!
5758!--        calculate t_green tendencies for the next Runge-Kutta step
5759              IF ( timestep_scheme(1:5) == 'runge' )  THEN
5760                  IF ( intermediate_timestep_count == 1 )  THEN
5761                     DO  kw = nzb_wall, nzt_wall
5762                        surf_usm_h%tt_green_m(kw,m) = gtend(kw)
5763                     ENDDO
5764                  ELSEIF ( intermediate_timestep_count <                           &
5765                           intermediate_timestep_count_max )  THEN
5766                      DO  kw = nzb_wall, nzt_wall
5767                         surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) +    &
5768                                            5.3125_wp * surf_usm_h%tt_green_m(kw,m)
5769                      ENDDO
5770                  ENDIF
5771              ENDIF
5772
5773              DO  kw = nzb_wall, nzt_wall
5774
5775!
5776!--              Calculate soil diffusivity at the center of the soil layers
5777                 lambda_green_temp(kw) = (- b_ch * surf_usm_h%gamma_w_green_sat(kw,m) * psi_sat       &
5778                                   / swc_sat_h(kw,m) ) * ( MAX( swc_h(kw,m),    &
5779                                   wilt_h(kw,m) ) / swc_sat_h(kw,m) )**(        &
5780                                   b_ch + 2.0_wp )
5781
5782!
5783!--              Parametrization of Van Genuchten
5784                 IF ( soil_type /= 7 )  THEN
5785!
5786!--                 Calculate the hydraulic conductivity after Van Genuchten
5787!--                 (1980)
5788                    h_vg = ( ( (swc_res_h(kw,m) - swc_sat_h(kw,m)) / ( swc_res_h(kw,m) -    &
5789                               MAX( swc_h(kw,m), wilt_h(kw,m) ) ) )**(      &
5790                               surf_usm_h%n_vg_green(m) / (surf_usm_h%n_vg_green(m) - 1.0_wp ) ) - 1.0_wp  &
5791                           )**( 1.0_wp / surf_usm_h%n_vg_green(m) ) / surf_usm_h%alpha_vg_green(m)
5792
5793
5794                    gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m) * ( ( (1.0_wp +         &
5795                                    ( surf_usm_h%alpha_vg_green(m) * h_vg )**surf_usm_h%n_vg_green(m))**(  &
5796                                    1.0_wp - 1.0_wp / surf_usm_h%n_vg_green(m) ) - (        &
5797                                    surf_usm_h%alpha_vg_green(m) * h_vg )**( surf_usm_h%n_vg_green(m)      &
5798                                    - 1.0_wp) )**2 )                         &
5799                                    / ( ( 1.0_wp + ( surf_usm_h%alpha_vg_green(m) * h_vg    &
5800                                    )**surf_usm_h%n_vg_green(m) )**( ( 1.0_wp  - 1.0_wp     &
5801                                    / surf_usm_h%n_vg_green(m) ) *( surf_usm_h%l_vg_green(m) + 2.0_wp) ) )
5802
5803!
5804!--              Parametrization of Clapp & Hornberger
5805                 ELSE
5806                    gamma_green_temp(kw) = surf_usm_h%gamma_w_green_sat(kw,m) * ( swc_h(kw,m)       &
5807                                    / swc_sat_h(kw,m) )**(2.0_wp * b_ch + 3.0_wp)
5808                 ENDIF
5809
5810              ENDDO
5811
5812!
5813!--           Prognostic equation for soil moisture content. Only performed,
5814!--           when humidity is enabled in the atmosphere
5815              IF ( humidity )  THEN
5816!
5817!--              Calculate soil diffusivity (lambda_w) at the _stag level
5818!--              using linear interpolation. To do: replace this with
5819!--              ECMWF-IFS Eq. 8.81
5820                 DO  kw = nzb_wall, nzt_wall-1
5821                   
5822                    surf_usm_h%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )  &
5823                                      * 0.5_wp
5824                    surf_usm_h%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1) + gamma_green_temp(kw) )    &
5825                                      * 0.5_wp
5826
5827                 ENDDO
5828
5829!
5830!--              In case of a closed bottom (= water content is conserved),
5831!--              set hydraulic conductivity to zero to that no water will be
5832!--              lost in the bottom layer.
5833                 IF ( conserve_water_content )  THEN
5834                    surf_usm_h%gamma_w_green(kw,m) = 0.0_wp
5835                 ELSE
5836                    surf_usm_h%gamma_w_green(kw,m) = gamma_green_temp(nzt_wall)
5837                 ENDIF     
5838
5839!--              The root extraction (= root_extr * qsws_veg / (rho_l     
5840!--              * l_v)) ensures the mass conservation for water. The         
5841!--              transpiration of plants equals the cumulative withdrawals by
5842!--              the roots in the soil. The scheme takes into account the
5843!--              availability of water in the soil layers as well as the root
5844!--              fraction in the respective layer. Layer with moisture below
5845!--              wilting point will not contribute, which reflects the
5846!--              preference of plants to take water from moister layers.
5847
5848!
5849!--              Calculate the root extraction (ECMWF 7.69, the sum of
5850!--              root_extr = 1). The energy balance solver guarantees a
5851!--              positive transpiration, so that there is no need for an
5852!--              additional check.
5853                 m_total = 0.0_wp
5854                 DO  kw = nzb_wall, nzt_wall
5855                     IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5856                        m_total = m_total + rootfr_h(kw,m) * swc_h(kw,m)
5857                     ENDIF
5858                 ENDDO 
5859
5860                 IF ( m_total > 0.0_wp )  THEN
5861                    DO  kw = nzb_wall, nzt_wall
5862                       IF ( swc_h(kw,m) > wilt_h(kw,m) )  THEN
5863                          root_extr_green(kw) = rootfr_h(kw,m) * swc_h(kw,m)      &
5864                                                          / m_total
5865                       ELSE
5866                          root_extr_green(kw) = 0.0_wp
5867                       ENDIF
5868                    ENDDO
5869                 ENDIF
5870
5871!
5872!--              Prognostic equation for soil water content m_soil.
5873                 tend(:) = 0.0_wp
5874
5875                 tend(nzb_wall) = ( surf_usm_h%lambda_w_green(nzb_wall,m) * (            &
5876                          swc_h(nzb_wall+1,m) - swc_h(nzb_wall,m) )    &
5877                          * surf_usm_h%ddz_green(nzb_wall+1,m) - surf_usm_h%gamma_w_green(nzb_wall,m) - ( &
5878                             root_extr_green(nzb_wall) * surf_usm_h%qsws_veg(m)          &
5879!                                + surf_usm_h%qsws_soil_green(m)
5880                                ) * drho_l_lv )             &
5881                               * surf_usm_h%ddz_green_stag(nzb_wall,m)
5882
5883                 DO  kw = nzb_wall+1, nzt_wall-1
5884                    tend(kw) = ( surf_usm_h%lambda_w_green(kw,m) * ( swc_h(kw+1,m)        &
5885                              - swc_h(kw,m) ) * surf_usm_h%ddz_green(kw+1,m)              &
5886                              - surf_usm_h%gamma_w_green(kw,m)                            &
5887                              - surf_usm_h%lambda_w_green(kw-1,m) * (swc_h(kw,m) -        &
5888                              swc_h(kw-1,m)) * surf_usm_h%ddz_green(kw,m)                 &
5889                              + surf_usm_h%gamma_w_green(kw-1,m) - (root_extr_green(kw)   &
5890                              * surf_usm_h%qsws_veg(m) * drho_l_lv)                       &
5891                              ) * surf_usm_h%ddz_green_stag(kw,m)
5892
5893                 ENDDO
5894                 tend(nzt_wall) = ( - surf_usm_h%gamma_w_green(nzt_wall,m)                  &
5895                                         - surf_usm_h%lambda_w_green(nzt_wall-1,m)          &
5896                                         * (swc_h(nzt_wall,m)             &
5897                                         - swc_h(nzt_wall-1,m))           &
5898                                         * surf_usm_h%ddz_green(nzt_wall,m)                 &
5899                                         + surf_usm_h%gamma_w_green(nzt_wall-1,m) - (       &
5900                                           root_extr_green(nzt_wall)               &
5901                                         * surf_usm_h%qsws_veg(m) * drho_l_lv  )   &
5902                                   ) * surf_usm_h%ddz_green_stag(nzt_wall,m)             
5903
5904                 swc_h_p(nzb_wall:nzt_wall,m) = swc_h(nzb_wall:nzt_wall,m)&
5905                                                 + dt_3d * ( tsc(2) * tend(:)   &
5906                                                 + tsc(3) * surf_usm_h%tswc_h_m(:,m) )   
5907 
5908!
5909!--              Account for dry soils (find a better solution here!)
5910                 DO  kw = nzb_wall, nzt_wall
5911                    IF ( swc_h_p(kw,m) < 0.0_wp )  swc_h_p(kw,m) = 0.0_wp
5912                 ENDDO
5913
5914!
5915!--              Calculate m_soil tendencies for the next Runge-Kutta step
5916                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
5917                    IF ( intermediate_timestep_count == 1 )  THEN
5918                       DO  kw = nzb_wall, nzt_wall
5919                          surf_usm_h%tswc_h_m(kw,m) = tend(kw)
5920                       ENDDO
5921                    ELSEIF ( intermediate_timestep_count <                   &
5922                             intermediate_timestep_count_max )  THEN
5923                       DO  kw = nzb_wall, nzt_wall
5924                          surf_usm_h%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp&
5925                                   * surf_usm_h%tswc_h_m(kw,m)
5926                       ENDDO
5927                    ENDIF
5928                 ENDIF
5929              ENDIF
5930
5931           ENDIF
5932           
5933        ENDDO
5934        !$OMP END PARALLEL
5935
5936!
5937!--     For vertical surfaces     
5938        DO  l = 0, 3                             
5939           DO  m = 1, surf_usm_v(l)%ns
5940
5941              IF (surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp) THEN
5942!
5943!-- no substrate layer for green walls / only groundbase green walls (ivy i.e.) -> green layers get same
5944!-- temperature as first wall layer
5945!-- there fore no temperature calculations for vertical green substrate layers now
5946
5947!
5948! !
5949! !--              Obtain indices
5950!                  i = surf_usm_v(l)%i(m)           
5951!                  j = surf_usm_v(l)%j(m)
5952!                  k = surf_usm_v(l)%k(m)
5953!   
5954!                  t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
5955! !
5956! !--              prognostic equation for green temperature t_green_v
5957!                  gtend(:) = 0.0_wp
5958!                  gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
5959!                                          ( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
5960!                                            ( t_green_v(l)%t(nzb_wall+1,m)             &
5961!                                            - t_green_v(l)%t(nzb_wall,m) ) *           &
5962!                                            surf_usm_v(l)%ddz_green(nzb_wall+1,m)      &
5963!                                          + surf_usm_v(l)%wghf_eb(m) ) *               &
5964!                                            surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
5965!               
5966!                  DO  kw = nzb_wall+1, nzt_wall
5967!                     gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m))          &
5968!                               * (   surf_usm_v(l)%lambda_h_green(kw,m)              &
5969!                                 * ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
5970!                                 * surf_usm_v(l)%ddz_green(kw+1,m)                   &
5971!                               - surf_usm_v(l)%lambda_h(kw-1,m)                      &
5972!                                 * ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
5973!                                 * surf_usm_v(l)%ddz_green(kw,m) )                   &
5974!                               * surf_usm_v(l)%ddz_green_stag(kw,m)
5975!                  ENDDO
5976!   
5977!                  t_green_v_p(l)%t(nzb_wall:nzt_wall,m) =                              &
5978!                                       t_green_v(l)%t(nzb_wall:nzt_wall,m)             &
5979!                                     + dt_3d * ( tsc(2)                                &
5980!                                     * gtend(nzb_wall:nzt_wall) + tsc(3)               &
5981!                                     * surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall,m) )   
5982!   
5983! !
5984! !--              calculate t_green tendencies for the next Runge-Kutta step
5985!                  IF ( timestep_scheme(1:5) == 'runge' )  THEN
5986!                      IF ( intermediate_timestep_count == 1 )  THEN
5987!                         DO  kw = nzb_wall, nzt_wall
5988!                            surf_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
5989!                         ENDDO
5990!                      ELSEIF ( intermediate_timestep_count <                           &
5991!                               intermediate_timestep_count_max )  THEN
5992!                          DO  kw = nzb_wall, nzt_wall
5993!                             surf_usm_v(l)%tt_green_m(kw,m) =                          &
5994!                                         - 9.5625_wp * gtend(kw) +                     &
5995!                                           5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
5996!                          ENDDO
5997!                      ENDIF
5998!                  ENDIF
5999
6000                 DO  kw = nzb_wall, nzt_wall+1
6001                     t_green_v(l)%t(kw,m) = t_wall_v(l)%t(nzb_wall,m)
6002                 ENDDO
6003             
6004              ENDIF
6005
6006           ENDDO
6007        ENDDO
6008
6009        IF ( debug_output_timestep )  CALL debug_message( 'usm_green_heat_model', 'end' )
6010
6011    END SUBROUTINE usm_green_heat_model
6012
6013!------------------------------------------------------------------------------!
6014! Description:
6015! ------------
6016!> Parin for &usm_par for urban surface model
6017!------------------------------------------------------------------------------!
6018    SUBROUTINE usm_parin
6019
6020       IMPLICIT NONE
6021
6022       CHARACTER (LEN=80) ::  line  !< string containing current line of file PARIN
6023
6024       NAMELIST /urban_surface_par/                                            &
6025                           building_type,                                      &
6026                           land_category,                                      &
6027                           naheatlayers,                                       &
6028                           pedestrian_category,                                &
6029                           roughness_concrete,                                 &
6030                           read_wall_temp_3d,                                  &
6031                           roof_category,                                      &
6032                           urban_surface,                                      &
6033                           usm_anthropogenic_heat,                             &
6034                           usm_material_model,                                 &
6035                           wall_category,                                      &
6036                           wall_inner_temperature,                             &
6037                           roof_inner_temperature,                             &
6038                           soil_inner_temperature,                             &
6039                           window_inner_temperature,                           &
6040                           usm_wall_mod
6041
6042       NAMELIST /urban_surface_parameters/                                     &
6043                           building_type,                                      &
6044                           land_category,                                      &
6045                           naheatlayers,                                       &
6046                           pedestrian_category,                                &
6047                           roughness_concrete,                                 &
6048                           read_wall_temp_3d,                                  &
6049                           roof_category,                                      &
6050                           urban_surface,                                      &
6051                           usm_anthropogenic_heat,                             &
6052                           usm_material_model,                                 &
6053                           wall_category,                                      &
6054                           wall_inner_temperature,                             &
6055                           roof_inner_temperature,                             &
6056                           soil_inner_temperature,                             &
6057                           window_inner_temperature,                           &
6058                           usm_wall_mod
6059                           
6060 
6061!
6062!--    Try to find urban surface model package
6063       REWIND ( 11 )
6064       line = ' '
6065       DO WHILE ( INDEX( line, '&urban_surface_parameters' ) == 0 )
6066          READ ( 11, '(A)', END=12 )  line
6067       ENDDO
6068       BACKSPACE ( 11 )
6069
6070!
6071!--    Read user-defined namelist
6072       READ ( 11, urban_surface_parameters, ERR = 10 )
6073
6074!
6075!--    Set flag that indicates that the urban surface model is switched on
6076       urban_surface = .TRUE.
6077
6078       GOTO 14
6079
6080 10    BACKSPACE( 11 )
6081       READ( 11 , '(A)') line
6082       CALL parin_fail_message( 'urban_surface_parameters', line )
6083!
6084!--    Try to find old namelist
6085 12    REWIND ( 11 )
6086       line = ' '
6087       DO WHILE ( INDEX( line, '&urban_surface_par' ) == 0 )
6088          READ ( 11, '(A)', END=14 )  line
6089       ENDDO
6090       BACKSPACE ( 11 )
6091
6092!
6093!--    Read user-defined namelist
6094       READ ( 11, urban_surface_par, ERR = 13, END = 14 )
6095
6096       message_string = 'namelist urban_surface_par is deprecated and will be ' // &
6097                     'removed in near future. Please use namelist ' //   &
6098                     'urban_surface_parameters instead'
6099       CALL message( 'usm_parin', 'PA0487', 0, 1, 0, 6, 0 )
6100
6101!
6102!--    Set flag that indicates that the urban surface model is switched on
6103       urban_surface = .TRUE.
6104
6105       GOTO 14
6106
6107 13    BACKSPACE( 11 )
6108       READ( 11 , '(A)') line
6109       CALL parin_fail_message( 'urban_surface_par', line )
6110
6111
6112 14    CONTINUE
6113
6114
6115    END SUBROUTINE usm_parin
6116
6117 
6118!------------------------------------------------------------------------------!
6119! Description:
6120! ------------
6121!
6122!> This subroutine is part of the urban surface model.
6123!> It reads daily heat produced by anthropogenic sources
6124!> and the diurnal cycle of the heat.
6125!------------------------------------------------------------------------------!
6126    SUBROUTINE usm_read_anthropogenic_heat
6127   
6128        INTEGER(iwp)                  :: i,j,k,ii  !< running indices
6129        REAL(wp)                      :: heat      !< anthropogenic heat
6130
6131!
6132!--     allocation of array of sources of anthropogenic heat and their diural profile
6133        ALLOCATE( aheat(naheatlayers,nys:nyn,nxl:nxr) )
6134        ALLOCATE( aheatprof(naheatlayers,0:24) )
6135
6136!
6137!--     read daily amount of heat and its daily cycle
6138        aheat = 0.0_wp
6139        DO  ii = 0, io_blocks-1
6140            IF ( ii == io_group )  THEN
6141
6142!--             open anthropogenic heat file
6143                OPEN( 151, file='ANTHROPOGENIC_HEAT'//TRIM(coupling_char), action='read', &
6144                           status='old', form='formatted', err=11 )
6145                i = 0
6146                j = 0
6147                DO
6148                    READ( 151, *, err=12, end=13 )  i, j, k, heat
6149                    IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )  THEN
6150                        IF ( k <= naheatlayers  .AND.  k > get_topography_top_index_ji( j, i, 's' ) )  THEN
6151!--                         write heat into the array
6152                            aheat(k,j,i) = heat
6153                        ENDIF
6154                    ENDIF
6155                    CYCLE
6156 12                 WRITE(message_string,'(a,2i4)') 'error in file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' after line ',i,j
6157                    CALL message( 'usm_read_anthropogenic_heat', 'PA0515', 0, 1, 0, 6, 0 )
6158                ENDDO
6159 13             CLOSE(151)
6160                CYCLE
6161 11             message_string = 'file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' does not exist'
6162                CALL message( 'usm_read_anthropogenic_heat', 'PA0516', 1, 2, 0, 6, 0 )
6163            ENDIF
6164           
6165#if defined( __parallel )
6166            CALL MPI_BARRIER( comm2d, ierr )
6167#endif
6168        ENDDO
6169       
6170!
6171!--     read diurnal profiles of heat sources
6172        aheatprof = 0.0_wp
6173        DO  ii = 0, io_blocks-1
6174            IF ( ii == io_group )  THEN
6175!
6176!--             open anthropogenic heat profile file
6177                OPEN( 151, file='ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char), action='read', &
6178                           status='old', form='formatted', err=21 )
6179                i = 0
6180                DO
6181                    READ( 151, *, err=22, end=23 )  i, k, heat
6182                    IF ( i >= 0  .AND.  i <= 24  .AND.  k <= naheatlayers )  THEN
6183!--                     write heat into the array
6184                        aheatprof(k,i) = heat
6185                    ENDIF
6186                    CYCLE
6187 22                 WRITE(message_string,'(a,i4)') 'error in file ANTHROPOGENIC_HEAT_PROFILE'// &
6188                                                     TRIM(coupling_char)//' after line ',i
6189                    CALL message( 'usm_read_anthropogenic_heat', 'PA0517', 0, 1, 0, 6, 0 )
6190                ENDDO
6191                aheatprof(:,24) = aheatprof(:,0)
6192 23             CLOSE(151)
6193                CYCLE
6194 21             message_string = 'file ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char)//' does not exist'
6195                CALL message( 'usm_read_anthropogenic_heat', 'PA0518', 1, 2, 0, 6, 0 )
6196            ENDIF
6197           
6198#if defined( __parallel )
6199            CALL MPI_BARRIER( comm2d, ierr )
6200#endif
6201        ENDDO
6202       
6203    END SUBROUTINE usm_read_anthropogenic_heat
6204   
6205
6206!------------------------------------------------------------------------------!
6207! Description:
6208! ------------
6209!> Soubroutine reads t_surf and t_wall data from restart files
6210!------------------------------------------------------------------------------!
6211    SUBROUTINE usm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, nyn_on_file,    &
6212                              nysf, nysc, nys_on_file, found )
6213
6214
6215       USE control_parameters,                                                 &
6216           ONLY: length, restart_string
6217           
6218       IMPLICIT NONE
6219
6220       INTEGER(iwp)       ::  k                 !< running index over previous input files covering current local domain
6221       INTEGER(iwp)       ::  l                 !< index variable for surface type
6222       INTEGER(iwp)       ::  ns_h_on_file_usm  !< number of horizontal surface elements (urban type) on file
6223       INTEGER(iwp)       ::  nxlc              !< index of left boundary on current subdomain
6224       INTEGER(iwp)       ::  nxlf              !< index of left boundary on former subdomain
6225       INTEGER(iwp)       ::  nxl_on_file       !< index of left boundary on former local domain
6226       INTEGER(iwp)       ::  nxrf              !< index of right boundary on former subdomain
6227       INTEGER(iwp)       ::  nxr_on_file       !< index of right boundary on former local domain
6228       INTEGER(iwp)       ::  nynf              !< index of north boundary on former subdomain
6229       INTEGER(iwp)       ::  nyn_on_file       !< index of north boundary on former local domain
6230       INTEGER(iwp)       ::  nysc              !< index of south boundary on current subdomain
6231       INTEGER(iwp)       ::  nysf              !< index of south boundary on former subdomain
6232       INTEGER(iwp)       ::  nys_on_file       !< index of south boundary on former local domain
6233       
6234       INTEGER(iwp)       ::  ns_v_on_file_usm(0:3)  !< number of vertical surface elements (urban type) on file
6235       
6236       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  start_index_on_file 
6237       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  end_index_on_file
6238
6239       LOGICAL, INTENT(OUT)  ::  found 
6240!!!    suehring: Why the SAVE attribute?       
6241       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_wall_h
6242       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_window_h
6243       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_green_h
6244       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_waste_h
6245       
6246       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_wall_h
6247       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_window_h
6248       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_green_h
6249       
6250       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v
6251       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_window_v
6252       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_green_v
6253       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_waste_v
6254       
6255       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_wall_v
6256       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_window_v
6257       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_green_v
6258
6259
6260       found = .TRUE.
6261
6262
6263          SELECT CASE ( restart_string(1:length) ) 
6264
6265             CASE ( 'ns_h_on_file_usm') 
6266                IF ( k == 1 )  THEN
6267                   READ ( 13 ) ns_h_on_file_usm
6268               
6269                   IF ( ALLOCATED( tmp_surf_wall_h ) ) DEALLOCATE( tmp_surf_wall_h )
6270                   IF ( ALLOCATED( tmp_wall_h ) ) DEALLOCATE( tmp_wall_h ) 
6271                   IF ( ALLOCATED( tmp_surf_window_h ) )                       &
6272                      DEALLOCATE( tmp_surf_window_h ) 
6273                   IF ( ALLOCATED( tmp_window_h) ) DEALLOCATE( tmp_window_h ) 
6274                   IF ( ALLOCATED( tmp_surf_green_h) )                         &
6275                      DEALLOCATE( tmp_surf_green_h ) 
6276                   IF ( ALLOCATED( tmp_green_h) ) DEALLOCATE( tmp_green_h )
6277                   IF ( ALLOCATED( tmp_surf_waste_h) )                         &
6278                      DEALLOCATE( tmp_surf_waste_h )
6279 
6280!
6281!--                Allocate temporary arrays for reading data on file. Note,
6282!--                the size of allocated surface elements do not necessarily
6283!--                need  to match the size of present surface elements on
6284!--                current processor, as the number of processors between
6285!--                restarts can change.
6286                   ALLOCATE( tmp_surf_wall_h(1:ns_h_on_file_usm) )
6287                   ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1,                   &
6288                                        1:ns_h_on_file_usm) )
6289                   ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
6290                   ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1,                 &
6291                                          1:ns_h_on_file_usm) )
6292                   ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
6293                   ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1,                  &
6294                                         1:ns_h_on_file_usm) )
6295                   ALLOCATE( tmp_surf_waste_h(1:ns_h_on_file_usm) )
6296
6297                ENDIF
6298
6299             CASE ( 'ns_v_on_file_usm')
6300                IF ( k == 1 )  THEN
6301                   READ ( 13 ) ns_v_on_file_usm 
6302
6303                   DO  l = 0, 3
6304                      IF ( ALLOCATED( tmp_surf_wall_v(l)%t ) )                 &
6305                         DEALLOCATE( tmp_surf_wall_v(l)%t )
6306                      IF ( ALLOCATED( tmp_wall_v(l)%t ) )                      &
6307                         DEALLOCATE( tmp_wall_v(l)%t )
6308                      IF ( ALLOCATED( tmp_surf_window_v(l)%t ) )               & 
6309                         DEALLOCATE( tmp_surf_window_v(l)%t )
6310                      IF ( ALLOCATED( tmp_window_v(l)%t ) )                    &
6311                         DEALLOCATE( tmp_window_v(l)%t )
6312                      IF ( ALLOCATED( tmp_surf_green_v(l)%t ) )                &
6313                         DEALLOCATE( tmp_surf_green_v(l)%t )
6314                      IF ( ALLOCATED( tmp_green_v(l)%t ) )                     &
6315                         DEALLOCATE( tmp_green_v(l)%t )
6316                      IF ( ALLOCATED( tmp_surf_waste_v(l)%t ) )                &
6317                         DEALLOCATE( tmp_surf_waste_v(l)%t )
6318                   ENDDO 
6319
6320!
6321!--                Allocate temporary arrays for reading data on file. Note,
6322!--                the size of allocated surface elements do not necessarily
6323!--                need to match the size of present surface elements on
6324!--                current processor, as the number of processors between
6325!--                restarts can change.
6326                   DO  l = 0, 3
6327                      ALLOCATE( tmp_surf_wall_v(l)%t(1:ns_v_on_file_usm(l)) )
6328                      ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1,           &
6329                                                1:ns_v_on_file_usm(l) ) )
6330                      ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
6331                      ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1,         & 
6332                                                  1:ns_v_on_file_usm(l) ) )
6333                      ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
6334                      ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1,          &
6335                                                 1:ns_v_on_file_usm(l) ) )
6336                      ALLOCATE( tmp_surf_waste_v(l)%t(1:ns_v_on_file_usm(l)) )
6337                   ENDDO
6338
6339                ENDIF   
6340         
6341             CASE ( 'usm_start_index_h', 'usm_start_index_v'  )   
6342                IF ( k == 1 )  THEN
6343
6344                   IF ( ALLOCATED( start_index_on_file ) )                     &
6345                      DEALLOCATE( start_index_on_file )
6346
6347                   ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file,     &
6348                                                  nxl_on_file:nxr_on_file) )
6349
6350                   READ ( 13 )  start_index_on_file
6351
6352                ENDIF
6353               
6354             CASE ( 'usm_end_index_h', 'usm_end_index_v' )   
6355                IF ( k == 1 )  THEN
6356
6357                   IF ( ALLOCATED( end_index_on_file ) )                       &
6358                      DEALLOCATE( end_index_on_file )
6359
6360                   ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file,       &
6361                                                nxl_on_file:nxr_on_file) )
6362
6363                   READ ( 13 )  end_index_on_file
6364
6365                ENDIF
6366         
6367             CASE ( 't_surf_wall_h' )
6368                IF ( k == 1 )  THEN
6369                   IF ( .NOT.  ALLOCATED( t_surf_wall_h_1 ) )                  &
6370                      ALLOCATE( t_surf_wall_h_1(1:surf_usm_h%ns) )
6371                   READ ( 13 )  tmp_surf_wall_h
6372                ENDIF             
6373                CALL surface_restore_elements(                                 &
6374                                        t_surf_wall_h_1, tmp_surf_wall_h,      &
6375                                        surf_usm_h%start_index,                &
6376                                        start_index_on_file,                   &
6377                                        end_index_on_file,                     &
6378                                        nxlc, nysc,                            &
6379                                        nxlf, nxrf, nysf, nynf,                &
6380                                        nys_on_file, nyn_on_file,              &
6381                                        nxl_on_file,nxr_on_file )
6382
6383             CASE ( 't_surf_wall_v(0)' )
6384                IF ( k == 1 )  THEN
6385                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(0)%t ) )             &
6386                      ALLOCATE( t_surf_wall_v_1(0)%t(1:surf_usm_v(0)%ns) )
6387                   READ ( 13 )  tmp_surf_wall_v(0)%t
6388                ENDIF
6389                CALL surface_restore_elements(                                 &
6390                                        t_surf_wall_v_1(0)%t, tmp_surf_wall_v(0)%t,      &
6391                                        surf_usm_v(0)%start_index,             & 
6392                                        start_index_on_file,                   &
6393                                        end_index_on_file,                     &
6394                                        nxlc, nysc,                            &
6395                                        nxlf, nxrf, nysf, nynf,                &
6396                                        nys_on_file, nyn_on_file,              &
6397                                        nxl_on_file,nxr_on_file )
6398                     
6399             CASE ( 't_surf_wall_v(1)' )
6400                IF ( k == 1 )  THEN
6401                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(1)%t ) )             &
6402                      ALLOCATE( t_surf_wall_v_1(1)%t(1:surf_usm_v(1)%ns) )
6403                   READ ( 13 )  tmp_surf_wall_v(1)%t
6404                ENDIF
6405                CALL surface_restore_elements(                                 &
6406                                        t_surf_wall_v_1(1)%t, tmp_surf_wall_v(1)%t,      &
6407                                        surf_usm_v(1)%start_index,             & 
6408                                        start_index_on_file,                   &
6409                                        end_index_on_file,                     &
6410                                        nxlc, nysc,                            &
6411                                        nxlf, nxrf, nysf, nynf,                &
6412                                        nys_on_file, nyn_on_file,              &
6413                                        nxl_on_file,nxr_on_file )
6414
6415             CASE ( 't_surf_wall_v(2)' )
6416                IF ( k == 1 )  THEN
6417                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(2)%t ) )             &
6418                      ALLOCATE( t_surf_wall_v_1(2)%t(1:surf_usm_v(2)%ns) )
6419                   READ ( 13 )  tmp_surf_wall_v(2)%t
6420                ENDIF
6421                CALL surface_restore_elements(                                 &
6422                                        t_surf_wall_v_1(2)%t, tmp_surf_wall_v(2)%t,      &
6423                                        surf_usm_v(2)%start_index,             & 
6424                                        start_index_on_file,                   &
6425                                        end_index_on_file,                     &
6426                                        nxlc, nysc,                            &
6427                                        nxlf, nxrf, nysf, nynf,                &
6428                                        nys_on_file, nyn_on_file,              &
6429                                        nxl_on_file,nxr_on_file )
6430                     
6431             CASE ( 't_surf_wall_v(3)' )
6432                IF ( k == 1 )  THEN
6433                   IF ( .NOT.  ALLOCATED( t_surf_wall_v_1(3)%t ) )             &
6434                      ALLOCATE( t_surf_wall_v_1(3)%t(1:surf_usm_v(3)%ns) )
6435                   READ ( 13 )  tmp_surf_wall_v(3)%t
6436                ENDIF
6437                CALL surface_restore_elements(                                 &
6438                                        t_surf_wall_v_1(3)%t, tmp_surf_wall_v(3)%t,      &
6439                                        surf_usm_v(3)%start_index,             & 
6440                                        start_index_on_file,                   &
6441                                        end_index_on_file,                     &
6442                                        nxlc, nysc,                            &
6443                                        nxlf, nxrf, nysf, nynf,                &
6444                                        nys_on_file, nyn_on_file,              &
6445                                        nxl_on_file,nxr_on_file )
6446
6447             CASE ( 't_surf_green_h' )
6448                IF ( k == 1 )  THEN
6449                   IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )                 &
6450                      ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
6451                   READ ( 13 )  tmp_surf_green_h
6452                ENDIF
6453                CALL surface_restore_elements(                                 &
6454                                        t_surf_green_h_1, tmp_surf_green_h,    &
6455                                        surf_usm_h%start_index,                & 
6456                                        start_index_on_file,                   &
6457                                        end_index_on_file,                     &
6458                                        nxlc, nysc,                            &
6459                                        nxlf, nxrf, nysf, nynf,                &
6460                                        nys_on_file, nyn_on_file,              &
6461                                        nxl_on_file,nxr_on_file )
6462
6463             CASE ( 't_surf_green_v(0)' )
6464                IF ( k == 1 )  THEN
6465                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%t ) )            &
6466                      ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
6467                   READ ( 13 )  tmp_surf_green_v(0)%t
6468                ENDIF
6469                CALL surface_restore_elements(                                 &
6470                                        t_surf_green_v_1(0)%t,                 &
6471                                        tmp_surf_green_v(0)%t,                 &
6472                                        surf_usm_v(0)%start_index,             & 
6473                                        start_index_on_file,                   &
6474                                        end_index_on_file,                     &
6475                                        nxlc, nysc,                            &
6476                                        nxlf, nxrf, nysf, nynf,                &
6477                                        nys_on_file, nyn_on_file,              &
6478                                        nxl_on_file,nxr_on_file )
6479                   
6480             CASE ( 't_surf_green_v(1)' )
6481                IF ( k == 1 )  THEN
6482                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%t ) )            &
6483                      ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
6484                   READ ( 13 )  tmp_surf_green_v(1)%t
6485                ENDIF
6486                CALL surface_restore_elements(                                 &
6487                                        t_surf_green_v_1(1)%t,                 &
6488                                        tmp_surf_green_v(1)%t,                 &
6489                                        surf_usm_v(1)%start_index,             & 
6490                                        start_index_on_file,                   &
6491                                        end_index_on_file,                     &
6492                                        nxlc, nysc,                            &
6493                                        nxlf, nxrf, nysf, nynf,                &
6494                                        nys_on_file, nyn_on_file,              &
6495                                        nxl_on_file,nxr_on_file )
6496
6497             CASE ( 't_surf_green_v(2)' )
6498                IF ( k == 1 )  THEN
6499                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%t ) )            &
6500                      ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
6501                   READ ( 13 )  tmp_surf_green_v(2)%t
6502                ENDIF
6503                CALL surface_restore_elements(                                 &
6504                                        t_surf_green_v_1(2)%t,                 &
6505                                        tmp_surf_green_v(2)%t,                 &
6506                                        surf_usm_v(2)%start_index,             & 
6507                                        start_index_on_file,                   &
6508                                        end_index_on_file,                     &
6509                                        nxlc, nysc,                            &
6510                                        nxlf, nxrf, nysf, nynf,                &
6511                                        nys_on_file, nyn_on_file,              &
6512                                        nxl_on_file,nxr_on_file )
6513                   
6514             CASE ( 't_surf_green_v(3)' )
6515                IF ( k == 1 )  THEN
6516                   IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%t ) )            &
6517                      ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
6518                   READ ( 13 )  tmp_surf_green_v(3)%t
6519                ENDIF
6520                CALL surface_restore_elements(                                 &
6521                                        t_surf_green_v_1(3)%t,                 & 
6522                                        tmp_surf_green_v(3)%t,                 &
6523                                        surf_usm_v(3)%start_index,             & 
6524                                        start_index_on_file,                   &
6525                                        end_index_on_file,                     &
6526                                        nxlc, nysc,                            &
6527                                        nxlf, nxrf, nysf, nynf,                &
6528                                        nys_on_file, nyn_on_file,              &
6529                                        nxl_on_file,nxr_on_file )
6530
6531             CASE ( 't_surf_window_h' )
6532                IF ( k == 1 )  THEN
6533                   IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )                &
6534                      ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
6535                   READ ( 13 )  tmp_surf_window_h
6536                ENDIF
6537                CALL surface_restore_elements(                                 &
6538                                        t_surf_window_h_1,                     &
6539                                        tmp_surf_window_h,                     &
6540                                        surf_usm_h%start_index,                & 
6541                                        start_index_on_file,                   &
6542                                        end_index_on_file,                     &
6543                                        nxlc, nysc,                            &
6544                                        nxlf, nxrf, nysf, nynf,                &
6545                                        nys_on_file, nyn_on_file,              &
6546                                        nxl_on_file,nxr_on_file )
6547
6548             CASE ( 't_surf_window_v(0)' )
6549                IF ( k == 1 )  THEN
6550                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%t ) )           &
6551                      ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
6552                   READ ( 13 )  tmp_surf_window_v(0)%t
6553                ENDIF
6554                CALL surface_restore_elements(                                 &
6555                                        t_surf_window_v_1(0)%t,                &
6556                                        tmp_surf_window_v(0)%t,                &
6557                                        surf_usm_v(0)%start_index,             & 
6558                                        start_index_on_file,                   &
6559                                        end_index_on_file,                     &
6560                                        nxlc, nysc,                            &
6561                                        nxlf, nxrf, nysf, nynf,                &
6562                                        nys_on_file, nyn_on_file,              &
6563                                        nxl_on_file,nxr_on_file )
6564                   
6565             CASE ( 't_surf_window_v(1)' )
6566                IF ( k == 1 )  THEN
6567                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%t ) )           &
6568                      ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
6569                   READ ( 13 )  tmp_surf_window_v(1)%t
6570                ENDIF
6571                CALL surface_restore_elements(                                 &
6572                                        t_surf_window_v_1(1)%t,                &
6573                                        tmp_surf_window_v(1)%t,                &
6574                                        surf_usm_v(1)%start_index,             & 
6575                                        start_index_on_file,                   &
6576                                        end_index_on_file,                     &
6577                                        nxlc, nysc,                            &
6578                                        nxlf, nxrf, nysf, nynf,                &
6579                                        nys_on_file, nyn_on_file,              &
6580                                        nxl_on_file,nxr_on_file )
6581
6582             CASE ( 't_surf_window_v(2)' )
6583                IF ( k == 1 )  THEN
6584                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%t ) )           &
6585                      ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
6586                   READ ( 13 )  tmp_surf_window_v(2)%t
6587                ENDIF
6588                CALL surface_restore_elements(                                 &
6589                                        t_surf_window_v_1(2)%t,                & 
6590                                        tmp_surf_window_v(2)%t,                &
6591                                        surf_usm_v(2)%start_index,             & 
6592                                        start_index_on_file,                   &
6593                                        end_index_on_file,                     &
6594                                        nxlc, nysc,                            &
6595                                        nxlf, nxrf, nysf, nynf,                &
6596                                        nys_on_file, nyn_on_file,              &
6597                                        nxl_on_file,nxr_on_file )
6598                   
6599             CASE ( 't_surf_window_v(3)' )
6600                IF ( k == 1 )  THEN
6601                   IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%t ) )           &
6602                      ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
6603                   READ ( 13 )  tmp_surf_window_v(3)%t
6604                ENDIF
6605                CALL surface_restore_elements(                                 &
6606                                        t_surf_window_v_1(3)%t,                & 
6607                                        tmp_surf_window_v(3)%t,                &
6608                                        surf_usm_v(3)%start_index,             & 
6609                                        start_index_on_file,                   &
6610                                        end_index_on_file,                     &
6611                                        nxlc, nysc,                            &
6612                                        nxlf, nxrf, nysf, nynf,                &
6613                                        nys_on_file, nyn_on_file,              &
6614                                        nxl_on_file,nxr_on_file )
6615
6616             CASE ( 'waste_heat_h' )
6617                IF ( k == 1 )  THEN
6618                   IF ( .NOT.  ALLOCATED( surf_usm_h%waste_heat ) )            &
6619                      ALLOCATE( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
6620                   READ ( 13 )  tmp_surf_waste_h
6621                ENDIF             
6622                CALL surface_restore_elements(                                 &
6623                                        surf_usm_h%waste_heat,                 &
6624                                        tmp_surf_waste_h,                      &
6625                                        surf_usm_h%start_index,                &
6626                                        start_index_on_file,                   &
6627                                        end_index_on_file,                     &
6628                                        nxlc, nysc,                            &
6629                                        nxlf, nxrf, nysf, nynf,                &
6630                                        nys_on_file, nyn_on_file,              &
6631                                        nxl_on_file,nxr_on_file )                 
6632                                       
6633             CASE ( 'waste_heat_v(0)' )
6634                IF ( k == 1 )  THEN
6635                   IF ( .NOT.  ALLOCATED( surf_usm_v(0)%waste_heat ) )         &
6636                      ALLOCATE( surf_usm_v(0)%waste_heat(1:surf_usm_v(0)%ns) )
6637                   READ ( 13 )  tmp_surf_waste_v(0)%t
6638                ENDIF
6639                CALL surface_restore_elements(                                 &
6640                                        surf_usm_v(0)%waste_heat,              &
6641                                        tmp_surf_waste_v(0)%t,                 &
6642                                        surf_usm_v(0)%start_index,             & 
6643                                        start_index_on_file,                   &
6644                                        end_index_on_file,                     &
6645                                        nxlc, nysc,                            &
6646                                        nxlf, nxrf, nysf, nynf,                &
6647                                        nys_on_file, nyn_on_file,              &
6648                                        nxl_on_file,nxr_on_file )
6649                     
6650             CASE ( 'waste_heat_v(1)' )
6651                IF ( k == 1 )  THEN
6652                   IF ( .NOT.  ALLOCATED( surf_usm_v(1)%waste_heat ) )         &
6653                      ALLOCATE( surf_usm_v(1)%waste_heat(1:surf_usm_v(1)%ns) )
6654                   READ ( 13 )  tmp_surf_waste_v(1)%t
6655                ENDIF
6656                CALL surface_restore_elements(                                 &
6657                                        surf_usm_v(1)%waste_heat,              &
6658                                        tmp_surf_waste_v(1)%t,                 &
6659                                        surf_usm_v(1)%start_index,             & 
6660                                        start_index_on_file,                   &
6661                                        end_index_on_file,                     &
6662                                        nxlc, nysc,                            &
6663                                        nxlf, nxrf, nysf, nynf,                &
6664                                        nys_on_file, nyn_on_file,              &
6665                                        nxl_on_file,nxr_on_file )
6666
6667             CASE ( 'waste_heat_v(2)' )
6668                IF ( k == 1 )  THEN
6669                   IF ( .NOT.  ALLOCATED( surf_usm_v(2)%waste_heat ) )         &
6670                      ALLOCATE( surf_usm_v(2)%waste_heat(1:surf_usm_v(2)%ns) )
6671                   READ ( 13 )  tmp_surf_waste_v(2)%t
6672                ENDIF
6673                CALL surface_restore_elements(                                 &
6674                                        surf_usm_v(2)%waste_heat,              &
6675                                        tmp_surf_waste_v(2)%t,                 &
6676                                        surf_usm_v(2)%start_index,             & 
6677                                        start_index_on_file,                   &
6678                                        end_index_on_file,                     &
6679                                        nxlc, nysc,                            &
6680                                        nxlf, nxrf, nysf, nynf,                &
6681                                        nys_on_file, nyn_on_file,              &
6682                                        nxl_on_file,nxr_on_file )
6683                     
6684             CASE ( 'waste_heat_v(3)' )
6685                IF ( k == 1 )  THEN
6686                   IF ( .NOT.  ALLOCATED( surf_usm_v(3)%waste_heat ) )         &
6687                      ALLOCATE( surf_usm_v(3)%waste_heat(1:surf_usm_v(3)%ns) )
6688                   READ ( 13 )  tmp_surf_waste_v(3)%t
6689                ENDIF
6690                CALL surface_restore_elements(                                 &
6691                                        surf_usm_v(3)%waste_heat,              &
6692                                        tmp_surf_waste_v(3)%t,                 &
6693                                        surf_usm_v(3)%start_index,             & 
6694                                        start_index_on_file,                   &
6695                                        end_index_on_file,                     &
6696                                        nxlc, nysc,                            &
6697                                        nxlf, nxrf, nysf, nynf,                &
6698                                        nys_on_file, nyn_on_file,              &
6699                                        nxl_on_file,nxr_on_file )
6700
6701             CASE ( 't_wall_h' )
6702                IF ( k == 1 )  THEN
6703                   IF ( .NOT.  ALLOCATED( t_wall_h_1 ) )                       &
6704                      ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1,                &
6705                                           1:surf_usm_h%ns) )
6706                   READ ( 13 )  tmp_wall_h
6707                ENDIF
6708                CALL surface_restore_elements(                                 &
6709                                        t_wall_h_1, tmp_wall_h,                &
6710                                        surf_usm_h%start_index,                & 
6711                                        start_index_on_file,                   &
6712                                        end_index_on_file,                     &
6713                                        nxlc, nysc,                            &
6714                                        nxlf, nxrf, nysf, nynf,                &
6715                                        nys_on_file, nyn_on_file,              &
6716                                        nxl_on_file,nxr_on_file )
6717
6718             CASE ( 't_wall_v(0)' )
6719                IF ( k == 1 )  THEN
6720                   IF ( .NOT.  ALLOCATED( t_wall_v_1(0)%t ) )                  &
6721                      ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1,           &
6722                                                1:surf_usm_v(0)%ns) )
6723                   READ ( 13 )  tmp_wall_v(0)%t
6724                ENDIF
6725                CALL surface_restore_elements(                                 &
6726                                        t_wall_v_1(0)%t, tmp_wall_v(0)%t,      &
6727                                        surf_usm_v(0)%start_index,             & 
6728                                        start_index_on_file,                   &
6729                                        end_index_on_file,                     &
6730                                        nxlc, nysc,                            &
6731                                        nxlf, nxrf, nysf, nynf,                &
6732                                        nys_on_file, nyn_on_file,              &
6733                                        nxl_on_file,nxr_on_file )
6734
6735             CASE ( 't_wall_v(1)' )
6736                IF ( k == 1 )  THEN
6737                   IF ( .NOT.  ALLOCATED( t_wall_v_1(1)%t ) )                  &
6738                      ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1,           &
6739                                                1:surf_usm_v(1)%ns) )
6740                   READ ( 13 )  tmp_wall_v(1)%t
6741                ENDIF
6742                CALL surface_restore_elements(                                 &
6743                                        t_wall_v_1(1)%t, tmp_wall_v(1)%t,      &
6744                                        surf_usm_v(1)%start_index,             & 
6745                                        start_index_on_file,                   &
6746                                        end_index_on_file,                     &
6747                                        nxlc, nysc,                            &
6748                                        nxlf, nxrf, nysf, nynf,                &
6749                                        nys_on_file, nyn_on_file,              &
6750                                        nxl_on_file,nxr_on_file )
6751
6752             CASE ( 't_wall_v(2)' )
6753                IF ( k == 1 )  THEN
6754                   IF ( .NOT.  ALLOCATED( t_wall_v_1(2)%t ) )                  &
6755                      ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1,           &
6756                                                1:surf_usm_v(2)%ns) )
6757                   READ ( 13 )  tmp_wall_v(2)%t
6758                ENDIF
6759                CALL surface_restore_elements(                                 &
6760                                        t_wall_v_1(2)%t, tmp_wall_v(2)%t,      &
6761                                        surf_usm_v(2)%start_index,             & 
6762                                        start_index_on_file,                   &
6763                                        end_index_on_file ,                    &
6764                                        nxlc, nysc,                            &
6765                                        nxlf, nxrf, nysf, nynf,                &
6766                                        nys_on_file, nyn_on_file,              &
6767                                        nxl_on_file,nxr_on_file )
6768
6769             CASE ( 't_wall_v(3)' )
6770                IF ( k == 1 )  THEN
6771                   IF ( .NOT.  ALLOCATED( t_wall_v_1(3)%t ) )                  &
6772                      ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1,           &
6773                                                1:surf_usm_v(3)%ns) )
6774                   READ ( 13 )  tmp_wall_v(3)%t
6775                ENDIF
6776                CALL surface_restore_elements(                                 &
6777                                        t_wall_v_1(3)%t, tmp_wall_v(3)%t,      &
6778                                        surf_usm_v(3)%start_index,             &   
6779                                        start_index_on_file,                   &
6780                                        end_index_on_file,                     &
6781                                        nxlc, nysc,                            &
6782                                        nxlf, nxrf, nysf, nynf,                &
6783                                        nys_on_file, nyn_on_file,              &
6784                                        nxl_on_file,nxr_on_file )
6785
6786             CASE ( 't_green_h' )
6787                IF ( k == 1 )  THEN
6788                   IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                      &
6789                      ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1,               &
6790                                            1:surf_usm_h%ns) )
6791                   READ ( 13 )  tmp_green_h
6792                ENDIF
6793                CALL surface_restore_elements(                                 &
6794                                        t_green_h_1, tmp_green_h,              &
6795                                        surf_usm_h%start_index,                & 
6796                                        start_index_on_file,                   &
6797                                        end_index_on_file,                     &
6798                                        nxlc, nysc,                            &
6799                                        nxlf, nxrf, nysf, nynf,                &
6800                                        nys_on_file, nyn_on_file,              &
6801                                        nxl_on_file,nxr_on_file )
6802
6803             CASE ( 't_green_v(0)' )
6804                IF ( k == 1 )  THEN
6805                   IF ( .NOT.  ALLOCATED( t_green_v_1(0)%t ) )                 &
6806                      ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1,          &
6807                                                 1:surf_usm_v(0)%ns) )
6808                   READ ( 13 )  tmp_green_v(0)%t
6809                ENDIF
6810                CALL surface_restore_elements(                                 &
6811                                        t_green_v_1(0)%t, tmp_green_v(0)%t,    &
6812                                        surf_usm_v(0)%start_index,             & 
6813                                        start_index_on_file,                   &
6814                                        end_index_on_file,                     &
6815                                        nxlc, nysc,                            &
6816                                        nxlf, nxrf, nysf, nynf,                &
6817                                        nys_on_file, nyn_on_file,              &
6818                                        nxl_on_file,nxr_on_file )
6819
6820             CASE ( 't_green_v(1)' )
6821                IF ( k == 1 )  THEN
6822                   IF ( .NOT.  ALLOCATED( t_green_v_1(1)%t ) )                 &
6823                      ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1,          &
6824                                                 1:surf_usm_v(1)%ns) )
6825                   READ ( 13 )  tmp_green_v(1)%t
6826                ENDIF
6827                CALL surface_restore_elements(                                 &
6828                                        t_green_v_1(1)%t, tmp_green_v(1)%t,    &
6829                                        surf_usm_v(1)%start_index,             & 
6830                                        start_index_on_file,                   &
6831                                        end_index_on_file,                     &
6832                                        nxlc, nysc,                            &
6833                                        nxlf, nxrf, nysf, nynf,                &
6834                                        nys_on_file, nyn_on_file,              &
6835                                        nxl_on_file,nxr_on_file )
6836
6837             CASE ( 't_green_v(2)' )
6838                IF ( k == 1 )  THEN
6839                   IF ( .NOT.  ALLOCATED( t_green_v_1(2)%t ) )                 &
6840                      ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1,          &
6841                                                 1:surf_usm_v(2)%ns) )
6842                   READ ( 13 )  tmp_green_v(2)%t
6843                ENDIF
6844                CALL surface_restore_elements(                                 &
6845                                        t_green_v_1(2)%t, tmp_green_v(2)%t,    &
6846                                        surf_usm_v(2)%start_index,             & 
6847                                        start_index_on_file,                   &
6848                                        end_index_on_file ,                    &
6849                                        nxlc, nysc,                            &
6850                                        nxlf, nxrf, nysf, nynf,                &
6851                                        nys_on_file, nyn_on_file,              &
6852                                        nxl_on_file,nxr_on_file )
6853
6854             CASE ( 't_green_v(3)' )
6855                IF ( k == 1 )  THEN
6856                   IF ( .NOT.  ALLOCATED( t_green_v_1(3)%t ) )                 &
6857                      ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1,          &
6858                                                 1:surf_usm_v(3)%ns) )
6859                   READ ( 13 )  tmp_green_v(3)%t
6860                ENDIF
6861                CALL surface_restore_elements(                                 &
6862                                        t_green_v_1(3)%t, tmp_green_v(3)%t,    &
6863                                        surf_usm_v(3)%start_index,             & 
6864                                        start_index_on_file,                   &
6865                                        end_index_on_file,                     &
6866                                        nxlc, nysc,                            &
6867                                        nxlf, nxrf, nysf, nynf,                &
6868                                        nys_on_file, nyn_on_file,              &
6869                                        nxl_on_file,nxr_on_file )
6870
6871             CASE ( 't_window_h' )
6872                IF ( k == 1 )  THEN
6873                   IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                     &
6874                      ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1,              &
6875                                             1:surf_usm_h%ns) )
6876                   READ ( 13 )  tmp_window_h
6877                ENDIF
6878                CALL surface_restore_elements(                                 &
6879                                        t_window_h_1, tmp_window_h,            &
6880                                        surf_usm_h%start_index,                & 
6881                                        start_index_on_file,                   &
6882                                        end_index_on_file,                     &
6883                                        nxlc, nysc,                            &
6884                                        nxlf, nxrf, nysf, nynf,                &
6885                                        nys_on_file, nyn_on_file,              &
6886                                        nxl_on_file, nxr_on_file )
6887
6888             CASE ( 't_window_v(0)' )
6889                IF ( k == 1 )  THEN
6890                   IF ( .NOT.  ALLOCATED( t_window_v_1(0)%t ) )                &
6891                      ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1,         &
6892                                                  1:surf_usm_v(0)%ns) )
6893                   READ ( 13 )  tmp_window_v(0)%t
6894                ENDIF
6895                CALL surface_restore_elements(                                 &
6896                                        t_window_v_1(0)%t,                     & 
6897                                        tmp_window_v(0)%t,                     &
6898                                        surf_usm_v(0)%start_index,             &
6899                                        start_index_on_file,                   &
6900                                        end_index_on_file,                     &
6901                                        nxlc, nysc,                            &
6902                                        nxlf, nxrf, nysf, nynf,                &
6903                                        nys_on_file, nyn_on_file,              &
6904                                        nxl_on_file,nxr_on_file )
6905
6906             CASE ( 't_window_v(1)' )
6907                IF ( k == 1 )  THEN
6908                   IF ( .NOT.  ALLOCATED( t_window_v_1(1)%t ) )                &
6909                      ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1,         &
6910                                                  1:surf_usm_v(1)%ns) )
6911                   READ ( 13 )  tmp_window_v(1)%t
6912                ENDIF
6913                CALL surface_restore_elements(                                 &
6914                                        t_window_v_1(1)%t,                     & 
6915                                        tmp_window_v(1)%t,                     &
6916                                        surf_usm_v(1)%start_index,             & 
6917                                        start_index_on_file,                   &
6918                                        end_index_on_file,                     &
6919                                        nxlc, nysc,                            &
6920                                        nxlf, nxrf, nysf, nynf,                &
6921                                        nys_on_file, nyn_on_file,              &
6922                                        nxl_on_file,nxr_on_file )
6923
6924             CASE ( 't_window_v(2)' )
6925                IF ( k == 1 )  THEN
6926                   IF ( .NOT.  ALLOCATED( t_window_v_1(2)%t ) )                &
6927                      ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1,         &
6928                                                  1:surf_usm_v(2)%ns) )
6929                   READ ( 13 )  tmp_window_v(2)%t
6930                ENDIF
6931                CALL surface_restore_elements(                                 &
6932                                        t_window_v_1(2)%t,                     & 
6933                                        tmp_window_v(2)%t,                     &
6934                                        surf_usm_v(2)%start_index,             & 
6935                                        start_index_on_file,                   &
6936                                        end_index_on_file ,                    &
6937                                        nxlc, nysc,                            &
6938                                        nxlf, nxrf, nysf, nynf,                &
6939                                        nys_on_file, nyn_on_file,              &
6940                                        nxl_on_file,nxr_on_file )
6941
6942             CASE ( 't_window_v(3)' )
6943                IF ( k == 1 )  THEN
6944                   IF ( .NOT.  ALLOCATED( t_window_v_1(3)%t ) )                &
6945                      ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
6946                   READ ( 13 )  tmp_window_v(3)%t
6947                ENDIF
6948                CALL surface_restore_elements(                                 &
6949                                        t_window_v_1(3)%t,                     & 
6950                                        tmp_window_v(3)%t,                     &
6951                                        surf_usm_v(3)%start_index,             & 
6952                                        start_index_on_file,                   &
6953                                        end_index_on_file,                     &
6954                                        nxlc, nysc,                            &
6955                                        nxlf, nxrf, nysf, nynf,                &
6956                                        nys_on_file, nyn_on_file,              &
6957                                        nxl_on_file,nxr_on_file )
6958
6959             CASE DEFAULT
6960
6961                   found = .FALSE.
6962
6963          END SELECT
6964
6965       
6966    END SUBROUTINE usm_rrd_local
6967
6968   
6969!------------------------------------------------------------------------------!
6970! Description:
6971! ------------
6972!
6973!> This subroutine reads walls, roofs and land categories and it parameters
6974!> from input files.
6975!------------------------------------------------------------------------------!
6976    SUBROUTINE usm_read_urban_surface_types
6977   
6978        USE netcdf_data_input_mod,                                             &
6979            ONLY:  building_pars_f, building_type_f
6980
6981        IMPLICIT NONE
6982
6983        CHARACTER(12)                                         :: wtn
6984        INTEGER(iwp)                                          :: wtc
6985        REAL(wp), DIMENSION(n_surface_params)                 :: wtp
6986        LOGICAL                                               :: ascii_file = .FALSE.
6987        INTEGER(iwp), DIMENSION(0:17, nysg:nyng, nxlg:nxrg)   :: usm_par
6988        REAL(wp), DIMENSION(1:14, nysg:nyng, nxlg:nxrg)       :: usm_val
6989        INTEGER(iwp)                                          :: k, l, iw, jw, kw, it, ip, ii, ij, m
6990        INTEGER(iwp)                                          :: i, j
6991        INTEGER(iwp)                                          :: nz, roof, dirwe, dirsn
6992        INTEGER(iwp)                                          :: category
6993        INTEGER(iwp)                                          :: weheight1, wecat1, snheight1, sncat1
6994        INTEGER(iwp)                                          :: weheight2, wecat2, snheight2, sncat2
6995        INTEGER(iwp)                                          :: weheight3, wecat3, snheight3, sncat3
6996        REAL(wp)                                              :: height, albedo, thick
6997        REAL(wp)                                              :: wealbedo1, wethick1, snalbedo1, snthick1
6998        REAL(wp)                                              :: wealbedo2, wethick2, snalbedo2, snthick2
6999        REAL(wp)                                              :: wealbedo3, wethick3, snalbedo3, snthick3
7000
7001
7002        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'start' )
7003!
7004!--     If building_pars or building_type are already read from static input
7005!--     file, skip reading ASCII file.
7006        IF ( building_type_f%from_file  .OR.  building_pars_f%from_file )      &
7007           RETURN
7008!
7009!--     Check if ASCII input file exists. If not, return and initialize USM
7010!--     with default settings.
7011        INQUIRE( FILE = 'SURFACE_PARAMETERS' // coupling_char,                 &
7012                 EXIST = ascii_file )
7013                 
7014        IF ( .NOT. ascii_file )  RETURN
7015
7016!
7017!--     read categories of walls and their parameters
7018        DO  ii = 0, io_blocks-1
7019            IF ( ii == io_group )  THEN
7020!
7021!--             open urban surface file
7022                OPEN( 151, file='SURFACE_PARAMETERS'//coupling_char, action='read', &
7023                           status='old', form='formatted', err=15 )
7024!
7025!--             first test and get n_surface_types
7026                k = 0
7027                l = 0
7028                DO
7029                    l = l+1
7030                    READ( 151, *, err=11, end=12 )  wtc, wtp, wtn
7031                    k = k+1
7032                    CYCLE
7033 11                 CONTINUE
7034                ENDDO
7035 12             n_surface_types = k
7036                ALLOCATE( surface_type_names(n_surface_types) )
7037                ALLOCATE( surface_type_codes(n_surface_types) )
7038                ALLOCATE( surface_params(n_surface_params, n_surface_types) )
7039!
7040!--             real reading
7041                rewind( 151 )
7042                k = 0
7043                DO
7044                    READ( 151, *, err=13, end=14 )  wtc, wtp, wtn
7045                    k = k+1
7046                    surface_type_codes(k) = wtc
7047                    surface_params(:,k) = wtp
7048                    surface_type_names(k) = wtn
7049                    CYCLE
705013                  WRITE(6,'(i3,a,2i5)') myid, 'readparams2 error k=', k
7051                    FLUSH(6)
7052                    CONTINUE
7053                ENDDO
7054 14             CLOSE(151)
7055                CYCLE
7056 15             message_string = 'file SURFACE_PARAMETERS'//TRIM(coupling_char)//' does not exist'
7057                CALL message( 'usm_read_urban_surface_types', 'PA0513', 1, 2, 0, 6, 0 )
7058            ENDIF
7059        ENDDO
7060   
7061!
7062!--     read types of surfaces
7063        usm_par = 0
7064        DO  ii = 0, io_blocks-1
7065            IF ( ii == io_group )  THEN
7066
7067!
7068!--             open csv urban surface file
7069                OPEN( 151, file='URBAN_SURFACE'//TRIM(coupling_char), action='read', &
7070                      status='old', form='formatted', err=23 )
7071               
7072                l = 0
7073                DO
7074                    l = l+1
7075!
7076!--                 i, j, height, nz, roof, dirwe, dirsn, category, soilcat,
7077!--                 weheight1, wecat1, snheight1, sncat1, weheight2, wecat2, snheight2, sncat2,
7078!--                 weheight3, wecat3, snheight3, sncat3
7079                    READ( 151, *, err=21, end=25 )  i, j, height, nz, roof, dirwe, dirsn,            &
7080                                            category, albedo, thick,                                 &
7081                                            weheight1, wecat1, wealbedo1, wethick1,                  &
7082                                            weheight2, wecat2, wealbedo2, wethick2,                  &
7083                                            weheight3, wecat3, wealbedo3, wethick3,                  &
7084                                            snheight1, sncat1, snalbedo1, snthick1,                  &
7085                                            snheight2, sncat2, snalbedo2, snthick2,                  &
7086                                            snheight3, sncat3, snalbedo3, snthick3
7087
7088                    IF ( i >= nxlg  .AND.  i <= nxrg  .AND.  j >= nysg  .AND.  j <= nyng )  THEN
7089!
7090!--                     write integer variables into array
7091                        usm_par(:,j,i) = (/1, nz, roof, dirwe, dirsn, category,                      &
7092                                          weheight1, wecat1, weheight2, wecat2, weheight3, wecat3,   &
7093                                          snheight1, sncat1, snheight2, sncat2, snheight3, sncat3 /)
7094!
7095!--                     write real values into array
7096                        usm_val(:,j,i) = (/ albedo, thick,                                           &
7097                                           wealbedo1, wethick1, wealbedo2, wethick2,                 &
7098                                           wealbedo3, wethick3, snalbedo1, snthick1,                 &
7099                                           snalbedo2, snthick2, snalbedo3, snthick3 /)
7100                    ENDIF
7101                    CYCLE
7102 21                 WRITE (message_string, "(A,I5)") 'errors in file URBAN_SURFACE'//TRIM(coupling_char)//' on line ', l
7103                    CALL message( 'usm_read_urban_surface_types', 'PA0512', 0, 1, 0, 6, 0 )
7104                ENDDO
7105         
7106 23             message_string = 'file URBAN_SURFACE'//TRIM(coupling_char)//' does not exist'
7107                CALL message( 'usm_read_urban_surface_types', 'PA0514', 1, 2, 0, 6, 0 )
7108
7109 25             CLOSE( 151 )
7110
7111            ENDIF
7112#if defined( __parallel )
7113            CALL MPI_BARRIER( comm2d, ierr )
7114#endif
7115        ENDDO
7116       
7117!
7118!--     check completeness and formal correctness of the data
7119        DO i = nxlg, nxrg
7120            DO j = nysg, nyng
7121                IF ( usm_par(0,j,i) /= 0  .AND.  (        &  !< incomplete data,supply default values later
7122                     usm_par(1,j,i) < nzb  .OR.           &
7123                     usm_par(1,j,i) > nzt  .OR.           &  !< incorrect height (nz < nzb  .OR.  nz > nzt)
7124                     usm_par(2,j,i) < 0  .OR.             &
7125                     usm_par(2,j,i) > 1  .OR.             &  !< incorrect roof sign
7126                     usm_par(3,j,i) < nzb-nzt  .OR.       & 
7127                     usm_par(3,j,i) > nzt-nzb  .OR.       &  !< incorrect west-east wall direction sign
7128                     usm_par(4,j,i) < nzb-nzt  .OR.       &
7129                     usm_par(4,j,i) > nzt-nzb  .OR.       &  !< incorrect south-north wall direction sign
7130                     usm_par(6,j,i) < nzb  .OR.           & 
7131                     usm_par(6,j,i) > nzt  .OR.           &  !< incorrect pedestrian level height for west-east wall
7132                     usm_par(8,j,i) > nzt  .OR.           &
7133                     usm_par(10,j,i) > nzt  .OR.          &  !< incorrect wall or roof level height for west-east wall
7134                     usm_par(12,j,i) < nzb  .OR.          & 
7135                     usm_par(12,j,i) > nzt  .OR.          &  !< incorrect pedestrian level height for south-north wall
7136                     usm_par(14,j,i) > nzt  .OR.          &
7137                     usm_par(16,j,i) > nzt                &  !< incorrect wall or roof level height for south-north wall
7138                    ) )  THEN
7139!
7140!--                 incorrect input data
7141                    WRITE (message_string, "(A,2I5)") 'missing or incorrect data in file URBAN_SURFACE'// &
7142                                                       TRIM(coupling_char)//' for i,j=', i,j
7143                    CALL message( 'usm_read_urban_surface', 'PA0504', 1, 2, 0, 6, 0 )
7144                ENDIF
7145               
7146            ENDDO
7147        ENDDO
7148!       
7149!--     Assign the surface types to the respective data type.
7150!--     First, for horizontal upward-facing surfaces.
7151!--     Further, set flag indicating that albedo is initialized via ASCII
7152!--     format, else it would be overwritten in the radiation model.
7153        surf_usm_h%albedo_from_ascii = .TRUE.
7154        DO  m = 1, surf_usm_h%ns
7155           iw = surf_usm_h%i(m)
7156           jw = surf_usm_h%j(m)
7157           kw = surf_usm_h%k(m)
7158
7159           IF ( usm_par(5,jw,iw) == 0 )  THEN
7160
7161              IF ( zu(kw) >= roof_height_limit )  THEN
7162                 surf_usm_h%isroof_surf(m)   = .TRUE.
7163                 surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
7164              ELSE
7165                 surf_usm_h%isroof_surf(m)   = .FALSE.
7166                 surf_usm_h%surface_types(m) = land_category         !< default category for land surface
7167              ENDIF
7168
7169              surf_usm_h%albedo(:,m)    = -1.0_wp
7170              surf_usm_h%thickness_wall(m) = -1.0_wp
7171              surf_usm_h%thickness_green(m) = -1.0_wp
7172              surf_usm_h%thickness_window(m) = -1.0_wp
7173           ELSE
7174              IF ( usm_par(2,jw,iw)==0 )  THEN
7175                 surf_usm_h%isroof_surf(m)    = .FALSE.
7176                 surf_usm_h%thickness_wall(m) = -1.0_wp
7177                 surf_usm_h%thickness_window(m) = -1.0_wp
7178                 surf_usm_h%thickness_green(m)  = -1.0_wp
7179              ELSE
7180                 surf_usm_h%isroof_surf(m)    = .TRUE.
7181                 surf_usm_h%thickness_wall(m) = usm_val(2,jw,iw)
7182                 surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
7183                 surf_usm_h%thickness_green(m)  = usm_val(2,jw,iw)
7184              ENDIF
7185              surf_usm_h%surface_types(m) = usm_par(5,jw,iw)
7186              surf_usm_h%albedo(:,m)   = usm_val(1,jw,iw)
7187              surf_usm_h%transmissivity(m)    = 0.0_wp
7188           ENDIF
7189!
7190!--        Find the type position
7191           it = surf_usm_h%surface_types(m)
7192           ip = -99999
7193           DO k = 1, n_surface_types
7194              IF ( surface_type_codes(k) == it )  THEN
7195                 ip = k
7196                 EXIT
7197              ENDIF
7198           ENDDO
7199           IF ( ip == -99999 )  THEN
7200!
7201!--           land/roof category not found
7202              WRITE (9,"(A,I5,A,3I5)") 'land/roof category ', it,     &
7203                                       ' not found  for i,j,k=', iw,jw,kw
7204              FLUSH(9)
7205              IF ( surf_usm_h%isroof_surf(m) ) THEN
7206                 category = roof_category
7207              ELSE
7208                 category = land_category
7209              ENDIF
7210              DO k = 1, n_surface_types
7211                 IF ( surface_type_codes(k) == roof_category ) THEN
7212                    ip = k
7213                    EXIT
7214                 ENDIF
7215              ENDDO
7216              IF ( ip == -99999 )  THEN
7217!
7218!--              default land/roof category not found
7219                 WRITE (9,"(A,I5,A,3I5)") 'Default land/roof category', category, ' not found!'
7220                 FLUSH(9)
7221                 ip = 1
7222              ENDIF
7223           ENDIF
7224!
7225!--        Albedo
7226           IF ( surf_usm_h%albedo(ind_veg_wall,m) < 0.0_wp )  THEN
7227              surf_usm_h%albedo(:,m) = surface_params(ialbedo,ip)
7228           ENDIF
7229!
7230!--        Albedo type is 0 (custom), others are replaced later
7231           surf_usm_h%albedo_type(:,m) = 0
7232!
7233!--        Transmissivity
7234           IF ( surf_usm_h%transmissivity(m) < 0.0_wp )  THEN
7235              surf_usm_h%transmissivity(m) = 0.0_wp
7236           ENDIF
7237!
7238!--        emissivity of the wall
7239           surf_usm_h%emissivity(:,m) = surface_params(iemiss,ip)
7240!           
7241!--        heat conductivity λS between air and wall ( W m−2 K−1 )
7242           surf_usm_h%lambda_surf(m) = surface_params(ilambdas,ip)
7243           surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
7244           surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
7245!           
7246!--        roughness length for momentum, heat and humidity
7247           surf_usm_h%z0(m) = surface_params(irough,ip)
7248           surf_usm_h%z0h(m) = surface_params(iroughh,ip)
7249           surf_usm_h%z0q(m) = surface_params(iroughh,ip)
7250!
7251!--        Surface skin layer heat capacity (J m−2 K−1 )
7252           surf_usm_h%c_surface(m) = surface_params(icsurf,ip)
7253           surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
7254           surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
7255!           
7256!--        wall material parameters:
7257!--        thickness of the wall (m)
7258!--        missing values are replaced by default value for category
7259           IF ( surf_usm_h%thickness_wall(m) <= 0.001_wp )  THEN
7260                surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
7261           ENDIF
7262           IF ( surf_usm_h%thickness_window(m) <= 0.001_wp )  THEN
7263                surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
7264           ENDIF
7265           IF ( surf_usm_h%thickness_green(m) <= 0.001_wp )  THEN
7266                surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
7267           ENDIF
7268!           
7269!--        volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
7270           surf_usm_h%rho_c_wall(:,m) = surface_params(irhoC,ip)
7271           surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
7272           surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
7273!           
7274!--        thermal conductivity λH of the wall (W m−1 K−1 )
7275           surf_usm_h%lambda_h(:,m) = surface_params(ilambdah,ip)
7276           surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7277           surf_usm_h%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
7278
7279        ENDDO
7280!
7281!--     For vertical surface elements ( 0 -- northward-facing, 1 -- southward-facing,
7282!--     2 -- eastward-facing, 3 -- westward-facing )
7283        DO  l = 0, 3
7284!
7285!--        Set flag indicating that albedo is initialized via ASCII format.
7286!--        Else it would be overwritten in the radiation model.
7287           surf_usm_v(l)%albedo_from_ascii = .TRUE.
7288           DO  m = 1, surf_usm_v(l)%ns
7289              i  = surf_usm_v(l)%i(m)
7290              j  = surf_usm_v(l)%j(m)
7291              kw = surf_usm_v(l)%k(m)
7292             
7293              IF ( l == 3 )  THEN ! westward facing
7294                 iw = i
7295                 jw = j
7296                 ii = 6
7297                 ij = 3
7298              ELSEIF ( l == 2 )  THEN
7299                 iw = i-1
7300                 jw = j
7301                 ii = 6
7302                 ij = 3
7303              ELSEIF ( l == 1 )  THEN
7304                 iw = i
7305                 jw = j
7306                 ii = 12
7307                 ij = 9
7308              ELSEIF ( l == 0 )  THEN
7309                 iw = i
7310                 jw = j-1
7311                 ii = 12
7312                 ij = 9
7313              ENDIF
7314
7315              IF ( iw < 0 .OR. jw < 0 ) THEN
7316!
7317!--              wall on west or south border of the domain - assign default category
7318                 IF ( kw <= roof_height_limit ) THEN
7319                     surf_usm_v(l)%surface_types(m) = wall_category   !< default category for wall surface in wall zone
7320                 ELSE
7321                     surf_usm_v(l)%surface_types(m) = roof_category   !< default category for wall surface in roof zone
7322                 END IF
7323                 surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7324                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7325                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7326                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7327                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7328              ELSE IF ( kw <= usm_par(ii,jw,iw) )  THEN
7329!
7330!--                 pedestrian zone
7331                 IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
7332                     surf_usm_v(l)%surface_types(m)  = pedestrian_category   !< default category for wall surface in
7333                                                                             !<pedestrian zone
7334                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7335                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7336                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7337                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7338                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7339                 ELSE
7340                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+1,jw,iw)
7341                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij,jw,iw)
7342                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+1,jw,iw)
7343                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+1,jw,iw)
7344                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+1,jw,iw)
7345                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7346                 ENDIF
7347              ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
7348!
7349!--              wall zone
7350                 IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
7351                     surf_usm_v(l)%surface_types(m)    = wall_category         !< default category for wall surface
7352                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7353                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7354                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7355                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7356                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7357                 ELSE
7358                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+3,jw,iw)
7359                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij+2,jw,iw)
7360                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+3,jw,iw)
7361                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+3,jw,iw)
7362                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+3,jw,iw)
7363                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7364                 ENDIF
7365              ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
7366!
7367!--              roof zone
7368                 IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
7369                     surf_usm_v(l)%surface_types(m)    = roof_category         !< default category for roof surface
7370                     surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7371                     surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7372                     surf_usm_v(l)%thickness_window(m) = -1.0_wp
7373                     surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7374                     surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7375                 ELSE
7376                     surf_usm_v(l)%surface_types(m)    = usm_par(ii+5,jw,iw)
7377                     surf_usm_v(l)%albedo(:,m)         = usm_val(ij+4,jw,iw)
7378                     surf_usm_v(l)%thickness_wall(m)   = usm_val(ij+5,jw,iw)
7379                     surf_usm_v(l)%thickness_window(m) = usm_val(ij+5,jw,iw)
7380                     surf_usm_v(l)%thickness_green(m)  = usm_val(ij+5,jw,iw)
7381                     surf_usm_v(l)%transmissivity(m)   = 0.0_wp
7382                 ENDIF
7383              ELSE
7384                 WRITE(9,*) 'Problem reading USM data:'
7385                 WRITE(9,*) l,i,j,kw,get_topography_top_index_ji( j, i, 's' )
7386                 WRITE(9,*) ii,iw,jw,kw,get_topography_top_index_ji( jw, iw, 's' )
7387                 WRITE(9,*) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw)
7388                 WRITE(9,*) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw)
7389                 WRITE(9,*) usm_par(ii+4,jw,iw),usm_par(ii+5,jw,iw)
7390                 WRITE(9,*) kw,roof_height_limit,wall_category,roof_category
7391                 FLUSH(9)
7392!
7393!--              supply the default category
7394                 IF ( kw <= roof_height_limit ) THEN
7395                     surf_usm_v(l)%surface_types(m) = wall_category   !< default category for wall surface in wall zone
7396                 ELSE
7397                     surf_usm_v(l)%surface_types(m) = roof_category   !< default category for wall surface in roof zone
7398                 END IF
7399                 surf_usm_v(l)%albedo(:,m)         = -1.0_wp
7400                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
7401                 surf_usm_v(l)%thickness_window(m) = -1.0_wp
7402                 surf_usm_v(l)%thickness_green(m)  = -1.0_wp
7403                 surf_usm_v(l)%transmissivity(m)   = -1.0_wp
7404              ENDIF
7405!
7406!--           Find the type position
7407              it = surf_usm_v(l)%surface_types(m)
7408              ip = -99999
7409              DO k = 1, n_surface_types
7410                 IF ( surface_type_codes(k) == it )  THEN
7411                    ip = k
7412                    EXIT
7413                 ENDIF
7414              ENDDO
7415              IF ( ip == -99999 )  THEN
7416!
7417!--              wall category not found
7418                 WRITE (9, "(A,I7,A,3I5)") 'wall category ', it,  &
7419                                           ' not found  for i,j,k=', iw,jw,kw
7420                 FLUSH(9)
7421                 category = wall_category 
7422                 DO k = 1, n_surface_types
7423                    IF ( surface_type_codes(k) == category ) THEN
7424                       ip = k
7425                       EXIT
7426                    ENDIF
7427                 ENDDO
7428                 IF ( ip == -99999 )  THEN
7429!
7430!--                 default wall category not found
7431                    WRITE (9, "(A,I5,A,3I5)") 'Default wall category', category, ' not found!'
7432                    FLUSH(9)
7433                    ip = 1
7434                 ENDIF
7435              ENDIF
7436
7437!
7438!--           Albedo
7439              IF ( surf_usm_v(l)%albedo(ind_veg_wall,m) < 0.0_wp )  THEN
7440                 surf_usm_v(l)%albedo(:,m) = surface_params(ialbedo,ip)
7441              ENDIF
7442!--           Albedo type is 0 (custom), others are replaced later
7443              surf_usm_v(l)%albedo_type(:,m) = 0
7444!--           Transmissivity of the windows
7445              IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp )  THEN
7446                 surf_usm_v(l)%transmissivity(m) = 0.0_wp
7447              ENDIF
7448!
7449!--           emissivity of the wall
7450              surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
7451!           
7452!--           heat conductivity lambda S between air and wall ( W m-2 K-1 )
7453              surf_usm_v(l)%lambda_surf(m) = surface_params(ilambdas,ip)
7454              surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
7455              surf_usm_v(l)%lambda_surf_green(m) = surface_params(ilambdas,ip)
7456!           
7457!--           roughness length
7458              surf_usm_v(l)%z0(m) = surface_params(irough,ip)
7459              surf_usm_v(l)%z0h(m) = surface_params(iroughh,ip)
7460              surf_usm_v(l)%z0q(m) = surface_params(iroughh,ip)
7461!           
7462!--           Surface skin layer heat capacity (J m-2 K-1 )
7463              surf_usm_v(l)%c_surface(m) = surface_params(icsurf,ip)
7464              surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
7465              surf_usm_v(l)%c_surface_green(m) = surface_params(icsurf,ip)
7466!           
7467!--           wall material parameters:
7468!--           thickness of the wall (m)
7469!--           missing values are replaced by default value for category
7470              IF ( surf_usm_v(l)%thickness_wall(m) <= 0.001_wp )  THEN
7471                   surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
7472              ENDIF
7473              IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp )  THEN
7474                   surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
7475              ENDIF
7476              IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp )  THEN
7477                   surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
7478              ENDIF
7479!
7480!--           volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
7481              surf_usm_v(l)%rho_c_wall(:,m) = surface_params(irhoC,ip)
7482              surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
7483              surf_usm_v(l)%rho_c_green(:,m) = surface_params(irhoC,ip)
7484!           
7485!--           thermal conductivity lambda H of the wall (W m-1 K-1 )
7486              surf_usm_v(l)%lambda_h(:,m) = surface_params(ilambdah,ip)
7487              surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7488              surf_usm_v(l)%lambda_h_green(:,m) = surface_params(ilambdah,ip)
7489
7490           ENDDO
7491        ENDDO 
7492
7493!
7494!--     Initialize wall layer thicknesses. Please note, this will be removed
7495!--     after migration to Palm input data standard. 
7496        DO k = nzb_wall, nzt_wall
7497           zwn(k) = zwn_default(k)
7498           zwn_green(k) = zwn_default_green(k)
7499           zwn_window(k) = zwn_default_window(k)
7500        ENDDO
7501!
7502!--     apply for all particular surface grids. First for horizontal surfaces
7503        DO  m = 1, surf_usm_h%ns
7504           surf_usm_h%zw(:,m) = zwn(:) * surf_usm_h%thickness_wall(m)
7505           surf_usm_h%zw_green(:,m) = zwn_green(:) * surf_usm_h%thickness_green(m)
7506           surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
7507        ENDDO
7508        DO  l = 0, 3
7509           DO  m = 1, surf_usm_v(l)%ns
7510              surf_usm_v(l)%zw(:,m) = zwn(:) * surf_usm_v(l)%thickness_wall(m)
7511              surf_usm_v(l)%zw_green(:,m) = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
7512              surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
7513           ENDDO
7514        ENDDO
7515
7516        IF ( debug_output )  CALL debug_message( 'usm_read_urban_surface_types', 'end' )
7517   
7518    END SUBROUTINE usm_read_urban_surface_types
7519
7520
7521!------------------------------------------------------------------------------!
7522! Description:
7523! ------------
7524!
7525!> This function advances through the list of local surfaces to find given
7526!> x, y, d, z coordinates
7527!------------------------------------------------------------------------------!
7528    PURE FUNCTION find_surface( x, y, z, d ) result(isurfl)
7529
7530        INTEGER(iwp), INTENT(in)                :: x, y, z, d
7531        INTEGER(iwp)                            :: isurfl
7532        INTEGER(iwp)                            :: isx, isy, isz
7533
7534        IF ( d == 0 ) THEN
7535           DO  isurfl = 1, surf_usm_h%ns
7536              isx = surf_usm_h%i(isurfl)
7537              isy = surf_usm_h%j(isurfl)
7538              isz = surf_usm_h%k(isurfl)
7539              IF ( isx==x .and. isy==y .and. isz==z )  RETURN
7540           ENDDO
7541        ELSE
7542           DO  isurfl = 1, surf_usm_v(d-1)%ns
7543              isx = surf_usm_v(d-1)%i(isurfl)
7544              isy = surf_usm_v(d-1)%j(isurfl)
7545              isz = surf_usm_v(d-1)%k(isurfl)
7546              IF ( isx==x .and. isy==y .and. isz==z )  RETURN
7547           ENDDO
7548        ENDIF
7549!
7550!--     coordinate not found
7551        isurfl = -1
7552
7553    END FUNCTION
7554
7555
7556!------------------------------------------------------------------------------!
7557! Description:
7558! ------------
7559!
7560!> This subroutine reads temperatures of respective material layers in walls,
7561!> roofs and ground from input files. Data in the input file must be in
7562!> standard order, i.e. horizontal surfaces first ordered by x, y and then
7563!> vertical surfaces ordered by x, y, direction, z
7564!------------------------------------------------------------------------------!
7565    SUBROUTINE usm_read_wall_temperature
7566
7567        INTEGER(iwp)                                          :: i, j, k, d, ii, iline  !> running indices
7568        INTEGER(iwp)                                          :: isurfl
7569        REAL(wp)                                              :: rtsurf
7570        REAL(wp), DIMENSION(nzb_wall:nzt_wall+1)              :: rtwall
7571
7572
7573        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'start' )
7574
7575        DO  ii = 0, io_blocks-1
7576            IF ( ii == io_group )  THEN
7577!
7578!--             open wall temperature file
7579                OPEN( 152, file='WALL_TEMPERATURE'//coupling_char, action='read', &
7580                           status='old', form='formatted', err=15 )
7581
7582                isurfl = 0
7583                iline = 1
7584                DO
7585                    rtwall = -9999.0_wp  !< for incomplete lines
7586                    READ( 152, *, err=13, end=14 )  i, j, k, d, rtsurf, rtwall
7587
7588                    IF ( nxl <= i .and. i <= nxr .and. &
7589                        nys <= j .and. j <= nyn)  THEN  !< local processor
7590!--                     identify surface id
7591                        isurfl = find_surface( i, j, k, d )
7592                        IF ( isurfl == -1 )  THEN
7593                            WRITE(message_string, '(a,4i5,a,i5,a)') 'Coordinates (xyzd) ', i, j, k, d, &
7594                                ' on line ', iline, &
7595                                ' in file WALL_TEMPERATURE are either not present or out of standard order of surfaces.'
7596                            CALL message( 'usm_read_wall_temperature', 'PA0521', 1, 2, 0, 6, 0 )
7597                        ENDIF
7598!
7599!--                     assign temperatures
7600                        IF ( d == 0 ) THEN
7601                           t_surf_wall_h(isurfl) = rtsurf
7602                           t_wall_h(:,isurfl) = rtwall(:)
7603                           t_window_h(:,isurfl) = rtwall(:)
7604                           t_green_h(:,isurfl) = rtwall(:)
7605                        ELSE
7606                           t_surf_wall_v(d-1)%t(isurfl) = rtsurf
7607                           t_wall_v(d-1)%t(:,isurfl) = rtwall(:)
7608                           t_window_v(d-1)%t(:,isurfl) = rtwall(:)
7609                           t_green_v(d-1)%t(:,isurfl) = rtwall(:)
7610                        ENDIF
7611                    ENDIF
7612
7613                    iline = iline + 1
7614                    CYCLE
7615 13                 WRITE(message_string, '(a,i5,a)') 'Error reading line ', iline, &
7616                        ' in file WALL_TEMPERATURE.'
7617                    CALL message( 'usm_read_wall_temperature', 'PA0522', 1, 2, 0, 6, 0 )
7618                ENDDO
7619 14             CLOSE(152)
7620                CYCLE
7621 15             message_string = 'file WALL_TEMPERATURE'//TRIM(coupling_char)//' does not exist'
7622                CALL message( 'usm_read_wall_temperature', 'PA0523', 1, 2, 0, 6, 0 )
7623            ENDIF
7624#if defined( __parallel )
7625            CALL MPI_BARRIER( comm2d, ierr )
7626#endif
7627        ENDDO
7628
7629        IF ( debug_output )  CALL debug_message( 'usm_read_wall_temperature', 'end' )
7630
7631    END SUBROUTINE usm_read_wall_temperature
7632
7633
7634
7635!------------------------------------------------------------------------------!
7636! Description:
7637! ------------
7638!> Solver for the energy balance at the ground/roof/wall surface.
7639!> It follows basic ideas and structure of lsm_energy_balance
7640!> with many simplifications and adjustments.
7641!> TODO better description
7642!> No calculation of window surface temperatures during spinup to increase
7643!> maximum possible timstep
7644!------------------------------------------------------------------------------!
7645    SUBROUTINE usm_surface_energy_balance( during_spinup )
7646
7647
7648        IMPLICIT NONE
7649
7650        INTEGER(iwp)                          :: i, j, k, l, m   !< running indices
7651       
7652        INTEGER(iwp) ::  i_off     !< offset to determine index of surface element, seen from atmospheric grid point, for x
7653        INTEGER(iwp) ::  j_off     !< offset to determine index of surface element, seen from atmospheric grid point, for y
7654        INTEGER(iwp) ::  k_off     !< offset to determine index of surface element, seen from atmospheric grid point, for z
7655
7656        LOGICAL                               :: during_spinup      !< flag indicating soil/wall spinup phase
7657       
7658        REAL(wp)                              :: frac_win           !< window fraction, used to restore original values during spinup
7659        REAL(wp)                              :: frac_green         !< green fraction, used to restore original values during spinup
7660        REAL(wp)                              :: frac_wall          !< wall fraction, used to restore original values during spinup
7661        REAL(wp)                              :: stend_wall         !< surface tendency
7662       
7663        REAL(wp)                              :: stend_window       !< surface tendency
7664        REAL(wp)                              :: stend_green        !< surface tendency
7665        REAL(wp)                              :: coef_1             !< first coeficient for prognostic equation
7666        REAL(wp)                              :: coef_window_1      !< first coeficient for prognostic window equation
7667        REAL(wp)                              :: coef_green_1       !< first coeficient for prognostic green wall equation
7668        REAL(wp)                              :: coef_2             !< second  coeficient for prognostic equation
7669        REAL(wp)                              :: coef_window_2      !< second  coeficient for prognostic window equation
7670        REAL(wp)                              :: coef_green_2       !< second  coeficient for prognostic green wall equation
7671        REAL(wp)                              :: rho_cp             !< rho_wall_surface * c_p
7672        REAL(wp)                              :: f_shf              !< factor for shf_eb
7673        REAL(wp)                              :: f_shf_window       !< factor for shf_eb window
7674        REAL(wp)                              :: f_shf_green        !< factor for shf_eb green wall
7675        REAL(wp)                              :: lambda_surface     !< current value of lambda_surface (heat conductivity
7676                                                                    !<between air and wall)
7677        REAL(wp)                              :: lambda_surface_window  !< current value of lambda_surface (heat conductivity
7678                                                                        !< between air and window)
7679        REAL(wp)                              :: lambda_surface_green   !< current value of lambda_surface (heat conductivity
7680                                                                        !< between air and greeb wall)
7681       
7682        REAL(wp)                              :: dtime              !< simulated time of day (in UTC)
7683        INTEGER(iwp)                          :: dhour              !< simulated hour of day (in UTC)
7684        REAL(wp)                              :: acoef              !< actual coefficient of diurnal profile of anthropogenic heat
7685        REAL(wp) ::  f1,          &  !< resistance correction term 1
7686                     f2,          &  !< resistance correction term 2
7687                     f3,          &  !< resistance correction term 3
7688                     e,           &  !< water vapour pressure
7689                     e_s,         &  !< water vapour saturation pressure
7690                     e_s_dt,      &  !< derivate of e_s with respect to T
7691                     tend,        &  !< tendency
7692                     dq_s_dt,     &  !< derivate of q_s with respect to T
7693                     f_qsws,      &  !< factor for qsws
7694                     f_qsws_veg,  &  !< factor for qsws_veg
7695                     f_qsws_liq,  &  !< factor for qsws_liq
7696                     m_liq_max,   &  !< maxmimum value of the liq. water reservoir
7697                     qv1,         &  !< specific humidity at first grid level
7698                     m_max_depth = 0.0002_wp, &  !< Maximum capacity of the water reservoir (m)
7699                     rho_lv,      &  !< frequently used parameter for green layers
7700                     drho_l_lv,   &  !< frequently used parameter for green layers
7701                     q_s             !< saturation specific humidity
7702
7703
7704        IF ( debug_output_timestep )  THEN
7705           WRITE( debug_string, * ) 'usm_surface_energy_balance | during_spinup: ',&
7706                                    during_spinup
7707           CALL debug_message( debug_string, 'start' )
7708        ENDIF
7709!
7710!--     Index offset of surface element point with respect to adjoining
7711!--     atmospheric grid point
7712        k_off = surf_usm_h%koff
7713        j_off = surf_usm_h%joff
7714        i_off = surf_usm_h%ioff
7715       
7716!       
7717!--     First, treat horizontal surface elements
7718        !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_surface, lambda_surface_window,                 &
7719        !$OMP&                  lambda_surface_green, qv1, rho_cp, rho_lv, drho_l_lv, f_shf,       &
7720        !$OMP&                  f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, f3, f_qsws_veg,&
7721        !$OMP&                  q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, coef_window_1,   &
7722        !$OMP&                  coef_green_1, coef_2, coef_window_2, coef_green_2, stend_wall,     &
7723        !$OMP&                  stend_window, stend_green, tend, m_liq_max)
7724        !$OMP DO SCHEDULE (STATIC)
7725        DO  m = 1, surf_usm_h%ns
7726!
7727!--       During spinup set green and window fraction to zero and restore
7728!--       at the end of the loop.
7729!--       Note, this is a temporary fix and need to be removed later. 
7730           IF ( during_spinup )  THEN
7731              frac_win   = surf_usm_h%frac(ind_wat_win,m)
7732              frac_wall  = surf_usm_h%frac(ind_veg_wall,m)
7733              frac_green = surf_usm_h%frac(ind_pav_green,m)
7734              surf_usm_h%frac(ind_wat_win,m)   = 0.0_wp
7735              surf_usm_h%frac(ind_veg_wall,m)  = 1.0_wp
7736              surf_usm_h%frac(ind_pav_green,m) = 0.0_wp
7737           ENDIF
7738!
7739!--        Get indices of respective grid point
7740           i = surf_usm_h%i(m)
7741           j = surf_usm_h%j(m)
7742           k = surf_usm_h%k(m)
7743!
7744!--        TODO - how to calculate lambda_surface for horizontal surfaces
7745!--        (lambda_surface is set according to stratification in land surface model)
7746!--        MS: ???
7747           IF ( surf_usm_h%ol(m) >= 0.0_wp )  THEN
7748              lambda_surface = surf_usm_h%lambda_surf(m)
7749              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7750              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7751           ELSE
7752              lambda_surface = surf_usm_h%lambda_surf(m)
7753              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7754              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7755           ENDIF
7756
7757!            pt1  = pt(k,j,i)
7758           IF ( humidity )  THEN
7759              qv1 = q(k,j,i)
7760           ELSE
7761              qv1 = 0.0_wp
7762           ENDIF
7763!
7764!--        calculate rho * c_p coefficient at surface layer
7765           rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exner(k) )
7766
7767           IF ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp )  THEN
7768!
7769!--           Calculate frequently used parameters
7770              rho_lv    = rho_cp / c_p * l_v
7771              drho_l_lv = 1.0_wp / (rho_l * l_v)
7772           ENDIF
7773
7774!
7775!--        Calculate aerodyamic resistance.
7776!--        Calculation for horizontal surfaces follows LSM formulation
7777!--        pt, us, ts are not available for the prognostic time step,
7778!--        data from the last time step is used here.
7779!
7780!--        Workaround: use single r_a as stability is only treated for the
7781!--        average temperature
7782           surf_usm_h%r_a(m) = ( surf_usm_h%pt1(m) - surf_usm_h%pt_surface(m) ) /&
7783                               ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )   
7784           surf_usm_h%r_a_window(m) = surf_usm_h%r_a(m)
7785           surf_usm_h%r_a_green(m)  = surf_usm_h%r_a(m)
7786
7787!            r_a = ( surf_usm_h%pt1(m) - t_surf_h(m) / exner(k) ) /                              &
7788!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7789!            r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exner(k) ) /                &
7790!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7791!            r_a_green = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /                  &
7792!                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7793               
7794!--        Make sure that the resistance does not drop to zero
7795           IF ( surf_usm_h%r_a(m)        < 1.0_wp )                            &
7796               surf_usm_h%r_a(m)        = 1.0_wp
7797           IF ( surf_usm_h%r_a_green(m)  < 1.0_wp )                            &
7798               surf_usm_h%r_a_green(m)  = 1.0_wp
7799           IF ( surf_usm_h%r_a_window(m) < 1.0_wp )                            &
7800               surf_usm_h%r_a_window(m) = 1.0_wp
7801             
7802!
7803!--        Make sure that the resistacne does not exceed a maxmium value in case
7804!--        of zero velocities
7805           IF ( surf_usm_h%r_a(m)        > 300.0_wp )                          &
7806               surf_usm_h%r_a(m)        = 300.0_wp
7807           IF ( surf_usm_h%r_a_green(m)  > 300.0_wp )                          &
7808               surf_usm_h%r_a_green(m)  = 300.0_wp
7809           IF ( surf_usm_h%r_a_window(m) > 300.0_wp )                          &
7810               surf_usm_h%r_a_window(m) = 300.0_wp               
7811               
7812!
7813!--        factor for shf_eb
7814           f_shf  = rho_cp / surf_usm_h%r_a(m)
7815           f_shf_window  = rho_cp / surf_usm_h%r_a_window(m)
7816           f_shf_green  = rho_cp / surf_usm_h%r_a_green(m)
7817       
7818
7819           IF ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) THEN
7820!--           Adapted from LSM:
7821!--           Second step: calculate canopy resistance r_canopy
7822!--           f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
7823 
7824!--           f1: correction for incoming shortwave radiation (stomata close at
7825!--           night)
7826              f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 0.05_wp ) / &
7827                               (0.81_wp * (0.004_wp * surf_usm_h%rad_sw_in(m)      &
7828                                + 1.0_wp)) )
7829!
7830!--           f2: correction for soil moisture availability to plants (the
7831!--           integrated soil moisture must thus be considered here)
7832!--           f2 = 0 for very dry soils
7833              m_total = 0.0_wp
7834              DO  k = nzb_wall, nzt_wall+1
7835                  m_total = m_total + rootfr_h(nzb_wall,m)                              &
7836                            * MAX(swc_h(nzb_wall,m),wilt_h(nzb_wall,m))
7837              ENDDO 
7838   
7839              IF ( m_total > wilt_h(nzb_wall,m)  .AND.  m_total < fc_h(nzb_wall,m) )  THEN
7840                 f2 = ( m_total - wilt_h(nzb_wall,m) ) / (fc_h(nzb_wall,m) - wilt_h(nzb_wall,m) )
7841              ELSEIF ( m_total >= fc_h(nzb_wall,m) )  THEN
7842                 f2 = 1.0_wp
7843              ELSE
7844                 f2 = 1.0E-20_wp
7845              ENDIF
7846       
7847!
7848!--          Calculate water vapour pressure at saturation
7849              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surf_green_h(m) &
7850                            - 273.16_wp ) / ( t_surf_green_h(m) - 35.86_wp ) )
7851!
7852!--           f3: correction for vapour pressure deficit
7853              IF ( surf_usm_h%g_d(m) /= 0.0_wp )  THEN
7854!
7855!--           Calculate vapour pressure
7856                 e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
7857                 f3 = EXP ( - surf_usm_h%g_d(m) * (e_s - e) )
7858              ELSE
7859                 f3 = 1.0_wp
7860              ENDIF
7861
7862!
7863!--           Calculate canopy resistance. In case that c_veg is 0 (bare soils),
7864!--           this calculation is obsolete, as r_canopy is not used below.
7865!--           To do: check for very dry soil -> r_canopy goes to infinity
7866              surf_usm_h%r_canopy(m) = surf_usm_h%r_canopy_min(m) /                   &
7867                              ( surf_usm_h%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
7868
7869!
7870!--           Calculate the maximum possible liquid water amount on plants and
7871!--           bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is
7872!--           assumed, while paved surfaces might hold up 1 mm of water. The
7873!--           liquid water fraction for paved surfaces is calculated after
7874!--           Noilhan & Planton (1989), while the ECMWF formulation is used for
7875!--           vegetated surfaces and bare soils.
7876              m_liq_max = m_max_depth * ( surf_usm_h%lai(m) )
7877              surf_usm_h%c_liq(m) = MIN( 1.0_wp, ( m_liq_usm_h%var_usm_1d(m) / m_liq_max )**0.67 )
7878!
7879!--           Calculate saturation specific humidity
7880              q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
7881!
7882!--           In case of dewfall, set evapotranspiration to zero
7883!--           All super-saturated water is then removed from the air
7884              IF ( humidity  .AND.  q_s <= qv1 )  THEN
7885                 surf_usm_h%r_canopy(m) = 0.0_wp
7886              ENDIF
7887
7888!
7889!--           Calculate coefficients for the total evapotranspiration
7890!--           In case of water surface, set vegetation and soil fluxes to zero.
7891!--           For pavements, only evaporation of liquid water is possible.
7892              f_qsws_veg  = rho_lv *                                           &
7893                                ( 1.0_wp        - surf_usm_h%c_liq(m)    ) /   &
7894                                ( surf_usm_h%r_a_green(m) + surf_usm_h%r_canopy(m) )
7895              f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m)   /                   &
7896                                  surf_usm_h%r_a_green(m)
7897       
7898              f_qsws = f_qsws_veg + f_qsws_liq
7899!
7900!--           Calculate derivative of q_s for Taylor series expansion
7901              e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_h(m) - 35.86_wp) -   &
7902                               17.269_wp*( t_surf_green_h(m) - 273.16_wp)      &
7903                              / ( t_surf_green_h(m) - 35.86_wp)**2 )
7904       
7905              dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
7906           ENDIF
7907!
7908!--        add LW up so that it can be removed in prognostic equation
7909           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  -                &
7910                                     surf_usm_h%rad_sw_out(m) +                &
7911                                     surf_usm_h%rad_lw_in(m)  -                &
7912                                     surf_usm_h%rad_lw_out(m)
7913!
7914!--     numerator of the prognostic equation
7915!--     Todo: Adjust to tile approach. So far, emissivity for wall (element 0)
7916!--     is used
7917           coef_1 = surf_usm_h%rad_net_l(m) +                                  & 
7918                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_veg_wall,m) * &
7919                                       sigma_sb * t_surf_wall_h(m) ** 4 +      & 
7920                                       f_shf * surf_usm_h%pt1(m) +             &
7921                                       lambda_surface * t_wall_h(nzb_wall,m)
7922           IF ( ( .NOT. during_spinup ) .AND. (surf_usm_h%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
7923              coef_window_1 = surf_usm_h%rad_net_l(m) +                           & 
7924                      ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_wat_win,m)  &
7925                                          * sigma_sb * t_surf_window_h(m) ** 4 +  & 
7926                                          f_shf_window * surf_usm_h%pt1(m) +      &
7927                                          lambda_surface_window * t_window_h(nzb_wall,m)
7928           ENDIF                 
7929           IF ( ( humidity ) .AND. ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
7930                    coef_green_1 = surf_usm_h%rad_net_l(m) +                                 & 
7931                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb * &
7932                                       t_surf_green_h(m) ** 4 +                  & 
7933                                          f_shf_green * surf_usm_h%pt1(m) + f_qsws * ( qv1 - q_s    &
7934                                          + dq_s_dt * t_surf_green_h(m) )        &
7935                                          +lambda_surface_green * t_green_h(nzb_wall,m)
7936           ELSE
7937           coef_green_1 = surf_usm_h%rad_net_l(m) +                            & 
7938                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_pav_green,m) *&
7939                                       sigma_sb * t_surf_green_h(m) ** 4 +     & 
7940                                       f_shf_green * surf_usm_h%pt1(m) +       &
7941                                       lambda_surface_green * t_green_h(nzb_wall,m)
7942          ENDIF
7943!
7944!--        denominator of the prognostic equation
7945           coef_2 = 4.0_wp * surf_usm_h%emissivity(ind_veg_wall,m) *           &
7946                             sigma_sb * t_surf_wall_h(m) ** 3                  &
7947                           + lambda_surface + f_shf / exner(k)
7948           IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_h%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
7949              coef_window_2 = 4.0_wp * surf_usm_h%emissivity(ind_wat_win,m) *     &
7950                                sigma_sb * t_surf_window_h(m) ** 3                &
7951                              + lambda_surface_window + f_shf_window / exner(k)
7952           ENDIF
7953           IF ( ( humidity ) .AND. ( surf_usm_h%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
7954              coef_green_2 = 4.0_wp * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb *    &
7955                                t_surf_green_h(m) ** 3 + f_qsws * dq_s_dt                    &
7956                              + lambda_surface_green + f_shf_green / exner(k)
7957           ELSE
7958           coef_green_2 = 4.0_wp * surf_usm_h%emissivity(ind_pav_green,m) * sigma_sb *    &
7959                             t_surf_green_h(m) ** 3                                       &
7960                           + lambda_surface_green + f_shf_green / exner(k)
7961           ENDIF
7962!
7963!--        implicit solution when the surface layer has no heat capacity,
7964!--        otherwise use RK3 scheme.
7965           t_surf_wall_h_p(m) = ( coef_1 * dt_3d * tsc(2) +                        &
7966                             surf_usm_h%c_surface(m) * t_surf_wall_h(m) ) /        & 
7967                           ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
7968           IF (( .NOT. during_spinup ) .AND. (surf_usm_h%frac(ind_wat_win,m) > 0.0_wp)) THEN
7969              t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) +                        &
7970                                surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) /        & 
7971                              ( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
7972           ENDIF
7973           t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) +                        &
7974                             surf_usm_h%c_surface_green(m) * t_surf_green_h(m) ) /        & 
7975                           ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
7976!
7977!--        add RK3 term
7978           t_surf_wall_h_p(m) = t_surf_wall_h_p(m) + dt_3d * tsc(3) *         &
7979                           surf_usm_h%tt_surface_wall_m(m)
7980
7981           t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) *     &
7982                           surf_usm_h%tt_surface_window_m(m)
7983
7984           t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) *       &
7985                           surf_usm_h%tt_surface_green_m(m)
7986!
7987!--        Store surface temperature on pt_surface. Further, in case humidity is used
7988!--        store also vpt_surface, which is, due to the lack of moisture on roofs simply
7989!--        assumed to be the surface temperature.
7990           surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(ind_veg_wall,m) * t_surf_wall_h_p(m)   &
7991                               + surf_usm_h%frac(ind_wat_win,m) * t_surf_window_h_p(m)         &
7992                               + surf_usm_h%frac(ind_pav_green,m) * t_surf_green_h_p(m) )      &
7993                               / exner(k)
7994                               
7995           IF ( humidity )  surf_usm_h%vpt_surface(m) =                        &
7996                                                   surf_usm_h%pt_surface(m)
7997!
7998!--        calculate true tendency
7999           stend_wall = ( t_surf_wall_h_p(m) - t_surf_wall_h(m) - dt_3d * tsc(3) *              &
8000                     surf_usm_h%tt_surface_wall_m(m)) / ( dt_3d  * tsc(2) )
8001           stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) *        &
8002                     surf_usm_h%tt_surface_window_m(m)) / ( dt_3d  * tsc(2) )
8003           stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) *           &
8004                     surf_usm_h%tt_surface_green_m(m)) / ( dt_3d  * tsc(2) )
8005!
8006!--        calculate t_surf tendencies for the next Runge-Kutta step
8007           IF ( timestep_scheme(1:5) == 'runge' )  THEN
8008              IF ( intermediate_timestep_count == 1 )  THEN
8009                 surf_usm_h%tt_surface_wall_m(m) = stend_wall
8010                 surf_usm_h%tt_surface_window_m(m) = stend_window
8011                 surf_usm_h%tt_surface_green_m(m) = stend_green
8012              ELSEIF ( intermediate_timestep_count <                          &
8013                        intermediate_timestep_count_max )  THEN
8014                 surf_usm_h%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +       &
8015                                     5.3125_wp * surf_usm_h%tt_surface_wall_m(m)
8016                 surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window +   &
8017                                     5.3125_wp * surf_usm_h%tt_surface_window_m(m)
8018                 surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green +     &
8019                                     5.3125_wp * surf_usm_h%tt_surface_green_m(m)
8020              ENDIF
8021           ENDIF
8022!
8023!--        in case of fast changes in the skin temperature, it is required to
8024!--        update the radiative fluxes in order to keep the solution stable
8025           IF ( ( ( ABS( t_surf_wall_h_p(m)   - t_surf_wall_h(m) )   > 1.0_wp )   .OR. &
8026                (   ABS( t_surf_green_h_p(m)  - t_surf_green_h(m) )  > 1.0_wp )   .OR. &
8027                (   ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) )      &
8028                   .AND.  unscheduled_radiation_calls  )  THEN
8029              force_radiation_call_l = .TRUE.
8030           ENDIF
8031!
8032!--        calculate fluxes
8033!--        rad_net_l is never used!
8034           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) +                           &
8035                                     surf_usm_h%frac(ind_veg_wall,m) *                   &
8036                                     sigma_sb * surf_usm_h%emissivity(ind_veg_wall,m) *  &
8037                                     ( t_surf_wall_h_p(m)**4 - t_surf_wall_h(m)**4 )     &
8038                                    + surf_usm_h%frac(ind_wat_win,m) *                   &
8039                                     sigma_sb * surf_usm_h%emissivity(ind_wat_win,m) *   &
8040                                     ( t_surf_window_h_p(m)**4 - t_surf_window_h(m)**4 ) &
8041                                    + surf_usm_h%frac(ind_pav_green,m) *                 &
8042                                     sigma_sb * surf_usm_h%emissivity(ind_pav_green,m) * &
8043                                     ( t_surf_green_h_p(m)**4 - t_surf_green_h(m)**4 )
8044
8045           surf_usm_h%wghf_eb(m)   = lambda_surface *                                    &
8046                                      ( t_surf_wall_h_p(m) - t_wall_h(nzb_wall,m) )
8047           surf_usm_h%wghf_eb_green(m)  = lambda_surface_green *                         &
8048                                          ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
8049           surf_usm_h%wghf_eb_window(m) = lambda_surface_window *                        &
8050                                           ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
8051
8052!
8053!--        ground/wall/roof surface heat flux
8054           surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_wall_h_p(m) / exner(k) ) *          &
8055                                       surf_usm_h%frac(ind_veg_wall,m)         &
8056                                     - f_shf_window  * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exner(k) ) * &
8057                                       surf_usm_h%frac(ind_wat_win,m)          &
8058                                     - f_shf_green  * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exner(k) ) *   &
8059                                       surf_usm_h%frac(ind_pav_green,m)
8060!           
8061!--        store kinematic surface heat fluxes for utilization in other processes
8062!--        diffusion_s, surface_layer_fluxes,...
8063           surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p
8064!
8065!--        If the indoor model is applied, further add waste heat from buildings to the
8066!--        kinematic flux.
8067           IF ( indoor_model )  THEN
8068              surf_usm_h%shf(m) = surf_usm_h%shf(m) + surf_usm_h%waste_heat(m) / c_p
8069           ENDIF
8070     
8071
8072           IF (surf_usm_h%frac(ind_pav_green,m) > 0.0_wp) THEN
8073             
8074           
8075              IF ( humidity )  THEN
8076                 surf_usm_h%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt                     &
8077                                 * t_surf_green_h(m) - dq_s_dt *               &
8078                                   t_surf_green_h_p(m) )
8079       
8080                 surf_usm_h%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s                      &
8081                                     + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8082                                     * t_surf_green_h_p(m) )
8083       
8084                 surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s                      &
8085                                     + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8086                                     * t_surf_green_h_p(m) )
8087                                     
8088              ENDIF
8089 
8090!
8091!--           Calculate the true surface resistance
8092              IF ( .NOT.  humidity )  THEN
8093                 surf_usm_h%r_s(m) = 1.0E10_wp
8094              ELSE
8095                 surf_usm_h%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt                       &
8096                                 *  t_surf_green_h(m) - dq_s_dt *              &
8097                                   t_surf_green_h_p(m) ) /                     &
8098                                   (surf_usm_h%qsws(m) + 1.0E-20)  - surf_usm_h%r_a_green(m)
8099              ENDIF
8100 
8101!
8102!--           Calculate change in liquid water reservoir due to dew fall or
8103!--           evaporation of liquid water
8104              IF ( humidity )  THEN
8105!
8106!--              If precipitation is activated, add rain water to qsws_liq
8107!--              and qsws_soil according the the vegetation coverage.
8108!--              precipitation_rate is given in mm.
8109                 IF ( precipitation )  THEN
8110
8111!
8112!--                 Add precipitation to liquid water reservoir, if possible.
8113!--                 Otherwise, add the water to soil. In case of
8114!--                 pavements, the exceeding water amount is implicitely removed
8115!--                 as runoff as qsws_soil is then not used in the soil model
8116                    IF ( m_liq_usm_h%var_usm_1d(m) /= m_liq_max )  THEN
8117                       surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m)                &
8118                                        + surf_usm_h%frac(ind_pav_green,m) * prr(k+k_off,j+j_off,i+i_off)&
8119                                        * hyrho(k+k_off)                              &
8120                                        * 0.001_wp * rho_l * l_v
8121                   ENDIF
8122
8123                 ENDIF
8124
8125!
8126!--              If the air is saturated, check the reservoir water level
8127                 IF ( surf_usm_h%qsws(m) < 0.0_wp )  THEN
8128!
8129!--                 Check if reservoir is full (avoid values > m_liq_max)
8130!--                 In that case, qsws_liq goes to qsws_soil. In this
8131!--                 case qsws_veg is zero anyway (because c_liq = 1),       
8132!--                 so that tend is zero and no further check is needed
8133                    IF ( m_liq_usm_h%var_usm_1d(m) == m_liq_max )  THEN
8134!                      surf_usm_h%qsws_soil(m) = surf_usm_h%qsws_soil(m) + surf_usm_h%qsws_liq(m)
8135                       surf_usm_h%qsws_liq(m)  = 0.0_wp
8136                    ENDIF
8137
8138!
8139!--                 In case qsws_veg becomes negative (unphysical behavior),
8140!--                 let the water enter the liquid water reservoir as dew on the
8141!--                 plant
8142                    IF ( surf_usm_h%qsws_veg(m) < 0.0_wp )  THEN
8143                       surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
8144                       surf_usm_h%qsws_veg(m) = 0.0_wp
8145                    ENDIF
8146                 ENDIF                   
8147 
8148                 surf_usm_h%qsws(m) = surf_usm_h%qsws(m) / l_v
8149       
8150                 tend = - surf_usm_h%qsws_liq(m) * drho_l_lv
8151                 m_liq_usm_h_p%var_usm_1d(m) = m_liq_usm_h%var_usm_1d(m) + dt_3d *    &
8152                                               ( tsc(2) * tend +                      &
8153                                                 tsc(3) * tm_liq_usm_h_m%var_usm_1d(m) )
8154!
8155!--             Check if reservoir is overfull -> reduce to maximum
8156!--             (conservation of water is violated here)
8157                 m_liq_usm_h_p%var_usm_1d(m) = MIN( m_liq_usm_h_p%var_usm_1d(m),m_liq_max )
8158 
8159!
8160!--             Check if reservoir is empty (avoid values < 0.0)
8161!--             (conservation of water is violated here)
8162                 m_liq_usm_h_p%var_usm_1d(m) = MAX( m_liq_usm_h_p%var_usm_1d(m), 0.0_wp )
8163!
8164!--             Calculate m_liq tendencies for the next Runge-Kutta step
8165                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
8166                    IF ( intermediate_timestep_count == 1 )  THEN
8167                       tm_liq_usm_h_m%var_usm_1d(m) = tend
8168                    ELSEIF ( intermediate_timestep_count <                            &
8169                             intermediate_timestep_count_max )  THEN
8170                       tm_liq_usm_h_m%var_usm_1d(m) = -9.5625_wp * tend +             &
8171                                                     5.3125_wp * tm_liq_usm_h_m%var_usm_1d(m)
8172                    ENDIF
8173                 ENDIF
8174 
8175              ENDIF
8176           ELSE
8177              surf_usm_h%r_s(m) = 1.0E10_wp
8178           ENDIF
8179!
8180!--        During spinup green and window fraction are set to zero. Here, the original
8181!--        values are restored.
8182           IF ( during_spinup )  THEN
8183              surf_usm_h%frac(ind_wat_win,m)   = frac_win
8184              surf_usm_h%frac(ind_veg_wall,m)  = frac_wall
8185              surf_usm_h%frac(ind_pav_green,m) = frac_green
8186           ENDIF
8187 
8188       ENDDO
8189!
8190!--    Now, treat vertical surface elements
8191       !$OMP DO SCHEDULE (STATIC)
8192       DO  l = 0, 3
8193           DO  m = 1, surf_usm_v(l)%ns
8194!
8195!--           During spinup set green and window fraction to zero and restore
8196!--           at the end of the loop.
8197!--           Note, this is a temporary fix and need to be removed later.
8198              IF ( during_spinup )  THEN
8199                 frac_win   = surf_usm_v(l)%frac(ind_wat_win,m)
8200                 frac_wall  = surf_usm_v(l)%frac(ind_veg_wall,m)
8201                 frac_green = surf_usm_v(l)%frac(ind_pav_green,m)
8202                 surf_usm_v(l)%frac(ind_wat_win,m)   = 0.0_wp
8203                 surf_usm_v(l)%frac(ind_veg_wall,m)  = 1.0_wp
8204                 surf_usm_v(l)%frac(ind_pav_green,m) = 0.0_wp
8205              ENDIF
8206!
8207!--          Get indices of respective grid point
8208              i = surf_usm_v(l)%i(m)
8209              j = surf_usm_v(l)%j(m)
8210              k = surf_usm_v(l)%k(m)
8211 
8212!
8213!--          TODO - how to calculate lambda_surface for horizontal (??? do you mean verical ???) surfaces
8214!--          (lambda_surface is set according to stratification in land surface model).
8215!--          Please note, for vertical surfaces no ol is defined, since
8216!--          stratification is not considered in this case.
8217              lambda_surface = surf_usm_v(l)%lambda_surf(m)
8218              lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
8219              lambda_surface_green = surf_usm_v(l)%lambda_surf_green(m)
8220 
8221!            pt1  = pt(k,j,i)
8222              IF ( humidity )  THEN
8223                 qv1 = q(k,j,i)
8224              ELSE
8225                 qv1 = 0.0_wp
8226              ENDIF
8227!
8228!--          calculate rho * c_p coefficient at wall layer
8229              rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) )
8230             
8231              IF (surf_usm_v(l)%frac(1,m) > 0.0_wp )  THEN
8232!
8233!--            Calculate frequently used parameters
8234                 rho_lv    = rho_cp / c_p * l_v
8235                 drho_l_lv = 1.0_wp / (rho_l * l_v)
8236              ENDIF
8237 
8238!--          Calculation of r_a for vertical surfaces
8239!--
8240!--          heat transfer coefficient for forced convection along vertical walls
8241!--          follows formulation in TUF3d model (Krayenhoff & Voogt, 2006)
8242!--           
8243!--          H = httc (Tsfc - Tair)
8244!--          httc = rw * (11.8 + 4.2 * Ueff) - 4.0
8245!--           
8246!--                rw: wall patch roughness relative to 1.0 for concrete
8247!--                Ueff: effective wind speed
8248!--                - 4.0 is a reduction of Rowley et al (1930) formulation based on
8249!--                Cole and Sturrock (1977)
8250!--           
8251!--                Ucan: Canyon wind speed
8252!--                wstar: convective velocity
8253!--                Qs: surface heat flux
8254!--                zH: height of the convective layer
8255!--                wstar = (g/Tcan*Qs*zH)**(1./3.)
8256!--          Effective velocity components must always
8257!--          be defined at scalar grid point. The wall normal component is
8258!--          obtained by simple linear interpolation. ( An alternative would
8259!--          be an logarithmic interpolation. )
8260!--          Parameter roughness_concrete (default value = 0.001) is used
8261!--          to calculation of roughness relative to concrete
8262              surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) /           &
8263                         roughness_concrete * ( 11.8_wp + 4.2_wp *              &
8264                         SQRT( MAX( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 + &
8265                                    ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 + &
8266                                    ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2,  &
8267                               0.01_wp ) )                                      &
8268                            )  - 4.0_wp  ) 
8269!
8270!--          Limit aerodynamic resistance
8271              IF ( surf_usm_v(l)%r_a(m) < 1.0_wp )  surf_usm_v(l)%r_a(m) = 1.0_wp   
8272             
8273                           
8274              f_shf         = rho_cp / surf_usm_v(l)%r_a(m)
8275              f_shf_window  = rho_cp / surf_usm_v(l)%r_a(m)
8276              f_shf_green   = rho_cp / surf_usm_v(l)%r_a(m)
8277 
8278
8279              IF ( surf_usm_v(l)%frac(1,m) > 0.0_wp ) THEN
8280!
8281!--             Adapted from LSM:
8282!--             Second step: calculate canopy resistance r_canopy
8283!--             f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
8284!--             f1: correction for incoming shortwave radiation (stomata close at
8285!--             night)
8286                 f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_v(l)%rad_sw_in(m) + 0.05_wp ) / &
8287                                  (0.81_wp * (0.004_wp * surf_usm_v(l)%rad_sw_in(m)      &
8288                                   + 1.0_wp)) )
8289!
8290!--             f2: correction for soil moisture availability to plants (the
8291!--             integrated soil moisture must thus be considered here)
8292!--             f2 = 0 for very dry soils
8293 
8294                 f2=1.0_wp
8295 
8296!
8297!--              Calculate water vapour pressure at saturation
8298                 e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * (  t_surf_green_v_p(l)%t(m) &
8299                               - 273.16_wp ) / (  t_surf_green_v_p(l)%t(m) - 35.86_wp ) )
8300!
8301!--              f3: correction for vapour pressure deficit
8302                 IF ( surf_usm_v(l)%g_d(m) /= 0.0_wp )  THEN
8303!
8304!--                 Calculate vapour pressure
8305                    e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
8306                    f3 = EXP ( - surf_usm_v(l)%g_d(m) * (e_s - e) )
8307                 ELSE
8308                    f3 = 1.0_wp
8309                 ENDIF
8310!
8311!--              Calculate canopy resistance. In case that c_veg is 0 (bare soils),
8312!--              this calculation is obsolete, as r_canopy is not used below.
8313!--              To do: check for very dry soil -> r_canopy goes to infinity
8314                 surf_usm_v(l)%r_canopy(m) = surf_usm_v(l)%r_canopy_min(m) /                  &
8315                                        ( surf_usm_v(l)%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
8316                               
8317!
8318!--              Calculate saturation specific humidity
8319                 q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8320!
8321!--              In case of dewfall, set evapotranspiration to zero
8322!--              All super-saturated water is then removed from the air
8323                 IF ( humidity  .AND.  q_s <= qv1 )  THEN
8324                    surf_usm_v(l)%r_canopy(m) = 0.0_wp
8325                 ENDIF
8326 
8327!
8328!--              Calculate coefficients for the total evapotranspiration
8329!--              In case of water surface, set vegetation and soil fluxes to zero.
8330!--              For pavements, only evaporation of liquid water is possible.
8331                 f_qsws_veg  = rho_lv *                                &
8332                                   ( 1.0_wp        - 0.0_wp ) / & !surf_usm_h%c_liq(m)    ) /   &
8333                                   ( surf_usm_v(l)%r_a(m) + surf_usm_v(l)%r_canopy(m) )
8334!                f_qsws_liq  = rho_lv * surf_usm_h%c_liq(m)   /             &
8335!                              surf_usm_h%r_a_green(m)
8336         
8337                 f_qsws = f_qsws_veg! + f_qsws_liq
8338!
8339!--              Calculate derivative of q_s for Taylor series expansion
8340                 e_s_dt = e_s * ( 17.269_wp / ( t_surf_green_v_p(l)%t(m) - 35.86_wp) -   &
8341                                  17.269_wp*( t_surf_green_v_p(l)%t(m) - 273.16_wp)      &
8342                                 / ( t_surf_green_v_p(l)%t(m) - 35.86_wp)**2 )
8343         
8344                 dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
8345              ENDIF
8346
8347!
8348!--           add LW up so that it can be removed in prognostic equation
8349              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m)  -        &
8350                                           surf_usm_v(l)%rad_sw_out(m) +        &
8351                                           surf_usm_v(l)%rad_lw_in(m)  -        &
8352                                           surf_usm_v(l)%rad_lw_out(m)
8353!
8354!--           numerator of the prognostic equation
8355              coef_1 = surf_usm_v(l)%rad_net_l(m) +                             & ! coef +1 corresponds to -lwout
8356                                                                                  ! included in calculation of radnet_l
8357              ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_veg_wall,m) *  &
8358                                      sigma_sb *  t_surf_wall_v(l)%t(m) ** 4 +  & 
8359                                      f_shf * surf_usm_v(l)%pt1(m) +            &
8360                                      lambda_surface * t_wall_v(l)%t(nzb_wall,m)
8361              IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
8362                 coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                   & ! coef +1 corresponds to -lwout
8363                                                                                  ! included in calculation of radnet_l
8364                ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_wat_win,m) * &
8365                                      sigma_sb * t_surf_window_v(l)%t(m) ** 4 + & 
8366                                      f_shf * surf_usm_v(l)%pt1(m) +            &
8367                                      lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
8368              ENDIF
8369              IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
8370                 coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                      & ! coef +1 corresponds to -lwout
8371                                                                                    ! included in calculation of radnet_l
8372                 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *  &
8373                                      t_surf_green_v(l)%t(m) ** 4 +               & 
8374                                      f_shf * surf_usm_v(l)%pt1(m) +     f_qsws * ( qv1 - q_s  &
8375                                           + dq_s_dt * t_surf_green_v(l)%t(m) ) +              &
8376                                      lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8377              ELSE
8378                coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                       & ! coef +1 corresponds to -lwout included
8379                                                                                    ! in calculation of radnet_l
8380                ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *  &
8381                                      t_surf_green_v(l)%t(m) ** 4 +               & 
8382                                      f_shf * surf_usm_v(l)%pt1(m) +              &
8383                                      lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
8384              ENDIF
8385                                     
8386!
8387!--           denominator of the prognostic equation
8388              coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_veg_wall,m) * sigma_sb *   &
8389                                 t_surf_wall_v(l)%t(m) ** 3                             &
8390                               + lambda_surface + f_shf / exner(k) 
8391              IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN             
8392                 coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_wat_win,m) * sigma_sb *       &
8393                                   t_surf_window_v(l)%t(m) ** 3                         &
8394                                 + lambda_surface_window + f_shf / exner(k)
8395              ENDIF
8396              IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) )  THEN
8397                  coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *     &
8398                                   t_surf_green_v(l)%t(m) ** 3  + f_qsws * dq_s_dt      &
8399                                 + lambda_surface_green + f_shf / exner(k)
8400              ELSE
8401                 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_pav_green,m) * sigma_sb *      &
8402                                   t_surf_green_v(l)%t(m) ** 3                          &
8403                                 + lambda_surface_green + f_shf / exner(k)
8404              ENDIF
8405!
8406!--           implicit solution when the surface layer has no heat capacity,
8407!--           otherwise use RK3 scheme.
8408              t_surf_wall_v_p(l)%t(m) = ( coef_1 * dt_3d * tsc(2) +                 &
8409                             surf_usm_v(l)%c_surface(m) * t_surf_wall_v(l)%t(m) ) / & 
8410                             ( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
8411              IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(ind_wat_win,m) > 0.0_wp ) ) THEN
8412                 t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) +                 &
8413                                surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / & 
8414                              ( surf_usm_v(l)%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) ) 
8415              ENDIF
8416              t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) +                 &
8417                             surf_usm_v(l)%c_surface_green(m) * t_surf_green_v(l)%t(m) ) / & 
8418                           ( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
8419!
8420!--           add RK3 term
8421              t_surf_wall_v_p(l)%t(m) = t_surf_wall_v_p(l)%t(m) + dt_3d * tsc(3) *         &
8422                                surf_usm_v(l)%tt_surface_wall_m(m)
8423              t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) *     &
8424                                surf_usm_v(l)%tt_surface_window_m(m)
8425              t_surf_green_v_p(l)%t(m) = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) *       &
8426                                 surf_usm_v(l)%tt_surface_green_m(m)
8427!
8428!--           Store surface temperature. Further, in case humidity is used
8429!--           store also vpt_surface, which is, due to the lack of moisture on roofs simply
8430!--           assumed to be the surface temperature.     
8431              surf_usm_v(l)%pt_surface(m) =  ( surf_usm_v(l)%frac(ind_veg_wall,m) * t_surf_wall_v_p(l)%t(m)  &
8432                                      + surf_usm_v(l)%frac(ind_wat_win,m) * t_surf_window_v_p(l)%t(m)        &
8433                                      + surf_usm_v(l)%frac(ind_pav_green,m) * t_surf_green_v_p(l)%t(m) )     &
8434                                      / exner(k)
8435                                       
8436              IF ( humidity )  surf_usm_v(l)%vpt_surface(m) =                  &
8437                                                     surf_usm_v(l)%pt_surface(m)
8438!
8439!--           calculate true tendency
8440              stend_wall = ( t_surf_wall_v_p(l)%t(m) - t_surf_wall_v(l)%t(m) - dt_3d * tsc(3) *      &
8441                        surf_usm_v(l)%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
8442              stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) *&
8443                        surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
8444              stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *   &
8445                        surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
8446
8447!
8448!--           calculate t_surf_* tendencies for the next Runge-Kutta step
8449              IF ( timestep_scheme(1:5) == 'runge' )  THEN
8450                 IF ( intermediate_timestep_count == 1 )  THEN
8451                    surf_usm_v(l)%tt_surface_wall_m(m) = stend_wall
8452                    surf_usm_v(l)%tt_surface_window_m(m) = stend_window
8453                    surf_usm_v(l)%tt_surface_green_m(m) = stend_green
8454                 ELSEIF ( intermediate_timestep_count <                                 &
8455                          intermediate_timestep_count_max )  THEN
8456                    surf_usm_v(l)%tt_surface_wall_m(m) = -9.5625_wp * stend_wall +      &
8457                                     5.3125_wp * surf_usm_v(l)%tt_surface_wall_m(m)
8458                    surf_usm_v(l)%tt_surface_green_m(m) = -9.5625_wp * stend_green +    &
8459                                     5.3125_wp * surf_usm_v(l)%tt_surface_green_m(m)
8460                    surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window +  &
8461                                     5.3125_wp * surf_usm_v(l)%tt_surface_window_m(m)
8462                 ENDIF
8463              ENDIF
8464
8465!
8466!--           in case of fast changes in the skin temperature, it is required to
8467!--           update the radiative fluxes in order to keep the solution stable
8468 
8469              IF ( ( ( ABS( t_surf_wall_v_p(l)%t(m)   - t_surf_wall_v(l)%t(m) )   > 1.0_wp ) .OR. &
8470                   (   ABS( t_surf_green_v_p(l)%t(m)  - t_surf_green_v(l)%t(m) )  > 1.0_wp ) .OR. &
8471                   (   ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) )    &
8472                      .AND.  unscheduled_radiation_calls )  THEN
8473                 force_radiation_call_l = .TRUE.
8474              ENDIF
8475
8476!
8477!--           calculate fluxes
8478!--           prognostic rad_net_l is used just for output!           
8479              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(ind_veg_wall,m) *                      &
8480                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8481                                           3.0_wp * sigma_sb *                                       &
8482                                           t_surf_wall_v(l)%t(m)**4 - 4.0_wp * sigma_sb *            &
8483                                           t_surf_wall_v(l)%t(m)**3 * t_surf_wall_v_p(l)%t(m) )      &
8484                                         + surf_usm_v(l)%frac(ind_wat_win,m) *                       &
8485                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8486                                           3.0_wp * sigma_sb *                                       &
8487                                           t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb *          &
8488                                           t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) )  &
8489                                         + surf_usm_v(l)%frac(ind_pav_green,m) *                     &
8490                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
8491                                           3.0_wp * sigma_sb *                                       &
8492                                           t_surf_green_v(l)%t(m)**4 - 4.0_wp * sigma_sb *           &
8493                                           t_surf_green_v(l)%t(m)**3 * t_surf_green_v_p(l)%t(m) )
8494
8495              surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window * &
8496                                                ( t_surf_window_v_p(l)%t(m) - t_window_v(l)%t(nzb_wall,m) )
8497              surf_usm_v(l)%wghf_eb(m)   = lambda_surface *             &
8498                                                ( t_surf_wall_v_p(l)%t(m) - t_wall_v(l)%t(nzb_wall,m) )
8499              surf_usm_v(l)%wghf_eb_green(m)  = lambda_surface_green *  &
8500                                                ( t_surf_green_v_p(l)%t(m) - t_green_v(l)%t(nzb_wall,m) )
8501
8502!
8503!--           ground/wall/roof surface heat flux
8504              surf_usm_v(l)%wshf_eb(m)   =                                     &
8505                 - f_shf  * ( surf_usm_v(l)%pt1(m) -                           &
8506                 t_surf_wall_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_veg_wall,m)       &
8507                 - f_shf_window  * ( surf_usm_v(l)%pt1(m) -                    &
8508                 t_surf_window_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_wat_win,m)&
8509                 - f_shf_green  * ( surf_usm_v(l)%pt1(m) -                     &
8510                 t_surf_green_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(ind_pav_green,m)
8511
8512!           
8513!--           store kinematic surface heat fluxes for utilization in other processes
8514!--           diffusion_s, surface_layer_fluxes,...
8515              surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / c_p
8516!
8517!--           If the indoor model is applied, further add waste heat from buildings to the
8518!--           kinematic flux.
8519              IF ( indoor_model )  THEN
8520                 surf_usm_v(l)%shf(m) = surf_usm_v(l)%shf(m) +                       &
8521                                        surf_usm_v(l)%waste_heat(m) / c_p
8522              ENDIF             
8523
8524              IF ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) THEN
8525 
8526
8527                 IF ( humidity )  THEN
8528                    surf_usm_v(l)%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt          &
8529                                    * t_surf_green_v(l)%t(m) - dq_s_dt *               &
8530                                      t_surf_green_v_p(l)%t(m) )
8531         
8532                    surf_usm_v(l)%qsws(m) = surf_usm_v(l)%qsws(m) / l_v
8533         
8534                    surf_usm_v(l)%qsws_veg(m)  = - f_qsws_veg  * ( qv1 - q_s           &
8535                                        + dq_s_dt * t_surf_green_v(l)%t(m) - dq_s_dt   &
8536                                        * t_surf_green_v_p(l)%t(m) )
8537         
8538!                    surf_usm_h%qsws_liq(m)  = - f_qsws_liq  * ( qv1 - q_s         &
8539!                                        + dq_s_dt * t_surf_green_h(m) - dq_s_dt   &
8540!                                        * t_surf_green_h_p(m) )
8541                 ENDIF
8542 
8543!
8544!--              Calculate the true surface resistance
8545                 IF ( .NOT.  humidity )  THEN
8546                    surf_usm_v(l)%r_s(m) = 1.0E10_wp
8547                 ELSE
8548                    surf_usm_v(l)%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt             &
8549                                    *  t_surf_green_v(l)%t(m) - dq_s_dt *               &
8550                                      t_surf_green_v_p(l)%t(m) ) /                      &
8551                                      (surf_usm_v(l)%qsws(m) + 1.0E-20)  - surf_usm_v(l)%r_a(m)
8552                 ENDIF
8553         
8554!
8555!--              Calculate change in liquid water reservoir due to dew fall or
8556!--              evaporation of liquid water
8557                 IF ( humidity )  THEN
8558!
8559!--                 If the air is saturated, check the reservoir water level
8560                    IF ( surf_usm_v(l)%qsws(m) < 0.0_wp )  THEN
8561       
8562!
8563!--                    In case qsws_veg becomes negative (unphysical behavior),
8564!--                    let the water enter the liquid water reservoir as dew on the
8565!--                    plant
8566                       IF ( surf_usm_v(l)%qsws_veg(m) < 0.0_wp )  THEN
8567          !                 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m)
8568                          surf_usm_v(l)%qsws_veg(m) = 0.0_wp
8569                       ENDIF
8570                    ENDIF
8571                 
8572                 ENDIF
8573              ELSE
8574                 surf_usm_v(l)%r_s(m) = 1.0E10_wp
8575              ENDIF
8576!
8577!--           During spinup green and window fraction are set to zero. Here, the original
8578!--           values are restored.
8579              IF ( during_spinup )  THEN
8580                 surf_usm_v(l)%frac(ind_wat_win,m)   = frac_win
8581                 surf_usm_v(l)%frac(ind_veg_wall,m)  = frac_wall
8582                 surf_usm_v(l)%frac(ind_pav_green,m) = frac_green
8583              ENDIF
8584
8585           ENDDO
8586 
8587       ENDDO
8588       !$OMP END PARALLEL
8589
8590!
8591!--     Add-up anthropogenic heat, for now only at upward-facing surfaces
8592         IF ( usm_anthropogenic_heat  .AND.  &
8593              intermediate_timestep_count == intermediate_timestep_count_max )  THEN
8594!
8595!--        application of the additional anthropogenic heat sources
8596!--        we considere the traffic for now so all heat is absorbed
8597!--        to the first layer, generalization would be worth.
8598!--        calculation of actual profile coefficient
8599!--        ??? check time_since_reference_point ???
8600            dtime = mod(simulated_time + time_utc_init, 24.0_wp*3600.0_wp)
8601            dhour = INT(dtime/3600.0_wp)
8602
8603!--         TO_DO: activate, if testcase is available
8604!--         !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
8605!--         it may also improve performance to move get_topography_top_index_ji before the k-loop
8606            DO i = nxl, nxr
8607               DO j = nys, nyn
8608                  DO k = nz_urban_b, min(nz_urban_t,naheatlayers)
8609                     IF ( k > get_topography_top_index_ji( j, i, 's' ) ) THEN
8610!
8611!--                    increase of pt in box i,j,k in time dt_3d
8612!--                    given to anthropogenic heat aheat*acoef (W*m-2)
8613!--                    linear interpolation of coeficient
8614                        acoef = (REAL(dhour+1,wp)-dtime/3600.0_wp)*aheatprof(k,dhour) + &
8615                                (dtime/3600.0_wp-REAL(dhour,wp))*aheatprof(k,dhour+1)
8616                        IF ( aheat(k,j,i) > 0.0_wp )  THEN
8617!
8618!--                       calculate rho * c_p coefficient at layer k
8619                           rho_cp  = c_p * hyp(k) / ( r_d * pt(k+1,j,i) * exner(k) )
8620                           pt(k,j,i) = pt(k,j,i) + aheat(k,j,i)*acoef*dt_3d/(exner(k)*rho_cp*dz(1))
8621                        ENDIF
8622                     ENDIF
8623                  ENDDO
8624               ENDDO
8625            ENDDO
8626 
8627         ENDIF
8628!
8629!--     pt and shf are defined on nxlg:nxrg,nysg:nyng
8630!--     get the borders from neighbours
8631         CALL exchange_horiz( pt, nbgp )
8632!
8633!--     calculation of force_radiation_call:
8634!--     Make logical OR for all processes.
8635!--     Force radiation call if at least one processor forces it.
8636         IF ( intermediate_timestep_count == intermediate_timestep_count_max-1 )&
8637         THEN
8638#if defined( __parallel )
8639           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
8640           CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,    &
8641                               1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
8642#else
8643           force_radiation_call = force_radiation_call_l
8644#endif
8645           force_radiation_call_l = .FALSE.
8646         ENDIF
8647 
8648! !
8649! !-- Calculate surface specific humidity
8650!     IF ( humidity )  THEN
8651!        CALL calc_q_surface_usm
8652!     ENDIF
8653 
8654 
8655!     CONTAINS
8656! !------------------------------------------------------------------------------!
8657! ! Description:
8658! ! ------------
8659! !> Calculation of specific humidity of the skin layer (surface). It is assumend
8660! !> that the skin is always saturated.
8661! !------------------------------------------------------------------------------!
8662!        SUBROUTINE calc_q_surface_usm
8663!
8664!           IMPLICIT NONE
8665!
8666!           REAL(wp) :: resistance    !< aerodynamic and soil resistance term
8667!
8668!           DO  m = 1, surf_usm_h%ns
8669!
8670!              i   = surf_usm_h%i(m)           
8671!              j   = surf_usm_h%j(m)
8672!              k   = surf_usm_h%k(m)
8673!
8674!!
8675!!--          Calculate water vapour pressure at saturation
8676!              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp *                  &
8677!                                     ( t_surf_green_h_p(m) - 273.16_wp ) /  &
8678!                                     ( t_surf_green_h_p(m) - 35.86_wp  )    &
8679!                                          )
8680!
8681!!
8682!!--          Calculate specific humidity at saturation
8683!              q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
8684!
8685!!              surf_usm_h%r_a_green(m) = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exner(k) ) /  &
8686!!                    ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
8687!!                 
8688!! !--          make sure that the resistance does not drop to zero
8689!!              IF ( ABS(surf_usm_h%r_a_green(m)) < 1.0E-10_wp )  surf_usm_h%r_a_green(m) = 1.0E-10_wp
8690!
8691!              resistance = surf_usm_h%r_a_green(m) / ( surf_usm_h%r_a_green(m) + surf_usm_h%r_s(m) + 1E-5_wp )
8692!
8693!!
8694!!--          Calculate specific humidity at surface
8695!              IF ( bulk_cloud_model )  THEN
8696!                 q(k,j,i) = resistance * q_s +                   &
8697!                                            ( 1.0_wp - resistance ) *              &
8698!                                            ( q(k,j,i) - ql(k,j,i) )
8699!              ELSE
8700!                 q(k,j,i) = resistance * q_s +                   &
8701!                                            ( 1.0_wp - resistance ) *              &
8702!                                              q(k,j,i)
8703!              ENDIF
8704!
8705!!
8706!!--          Update virtual potential temperature
8707!              vpt(k,j,i) = pt(k,j,i) *         &
8708!                         ( 1.0_wp + 0.61_wp * q(k,j,i) )
8709!
8710!           ENDDO
8711!
8712!!
8713!!--       Now, treat vertical surface elements
8714!           DO  l = 0, 3
8715!              DO  m = 1, surf_usm_v(l)%ns
8716!!
8717!!--             Get indices of respective grid point
8718!                 i = surf_usm_v(l)%i(m)
8719!                 j = surf_usm_v(l)%j(m)
8720!                 k = surf_usm_v(l)%k(m)
8721!
8722!!
8723!!--             Calculate water vapour pressure at saturation
8724!                 e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp *                       &
8725!                                        ( t_surf_green_v_p(l)%t(m) - 273.16_wp ) /  &
8726!                                        ( t_surf_green_v_p(l)%t(m) - 35.86_wp  )    &
8727!                                             )
8728!
8729!!
8730!!--             Calculate specific humidity at saturation
8731!                 q_s = 0.622_wp * e_s / ( surface_pressure -e_s )
8732!
8733!!
8734!!--             Calculate specific humidity at surface
8735!                 IF ( bulk_cloud_model )  THEN
8736!                    q(k,j,i) = ( q(k,j,i) - ql(k,j,i) )
8737!                 ELSE
8738!                    q(k,j,i) = q(k,j,i)
8739!                 ENDIF
8740!!
8741!!--             Update virtual potential temperature
8742!                 vpt(k,j,i) = pt(k,j,i) *         &
8743!                            ( 1.0_wp + 0.61_wp * q(k,j,i) )
8744!
8745!              ENDDO
8746!
8747!           ENDDO
8748!
8749!        END SUBROUTINE calc_q_surface_usm
8750
8751        IF ( debug_output_timestep )  THEN
8752           WRITE( debug_string, * ) 'usm_surface_energy_balance | during_spinup: ',&
8753                                    during_spinup
8754           CALL debug_message( debug_string, 'end' )
8755        ENDIF
8756
8757     END SUBROUTINE usm_surface_energy_balance
8758 
8759 
8760!------------------------------------------------------------------------------!
8761! Description:
8762! ------------
8763!> Swapping of timelevels for t_surf and t_wall
8764!> called out from subroutine swap_timelevel
8765!------------------------------------------------------------------------------!
8766     SUBROUTINE usm_swap_timelevel( mod_count )
8767 
8768        IMPLICIT NONE
8769 
8770        INTEGER(iwp), INTENT(IN) ::  mod_count
8771 
8772       
8773        SELECT CASE ( mod_count )
8774 
8775           CASE ( 0 )
8776!
8777!--          Horizontal surfaces
8778              t_surf_wall_h    => t_surf_wall_h_1;   t_surf_wall_h_p    => t_surf_wall_h_2
8779              t_wall_h         => t_wall_h_1;        t_wall_h_p         => t_wall_h_2
8780              t_surf_window_h  => t_surf_window_h_1; t_surf_window_h_p  => t_surf_window_h_2
8781              t_window_h       => t_window_h_1;      t_window_h_p       => t_window_h_2
8782              t_surf_green_h   => t_surf_green_h_1;  t_surf_green_h_p   => t_surf_green_h_2
8783              t_green_h        => t_green_h_1;       t_green_h_p        => t_green_h_2
8784!
8785!--          Vertical surfaces
8786              t_surf_wall_v    => t_surf_wall_v_1;   t_surf_wall_v_p    => t_surf_wall_v_2
8787              t_wall_v         => t_wall_v_1;        t_wall_v_p         => t_wall_v_2
8788              t_surf_window_v  => t_surf_window_v_1; t_surf_window_v_p  => t_surf_window_v_2
8789              t_window_v       => t_window_v_1;      t_window_v_p       => t_window_v_2
8790              t_surf_green_v   => t_surf_green_v_1;  t_surf_green_v_p   => t_surf_green_v_2
8791              t_green_v        => t_green_v_1;       t_green_v_p        => t_green_v_2
8792           CASE ( 1 )
8793!
8794!--          Horizontal surfaces
8795              t_surf_wall_h    => t_surf_wall_h_2;   t_surf_wall_h_p    => t_surf_wall_h_1
8796              t_wall_h         => t_wall_h_2;        t_wall_h_p         => t_wall_h_1
8797              t_surf_window_h  => t_surf_window_h_2; t_surf_window_h_p  => t_surf_window_h_1
8798              t_window_h       => t_window_h_2;      t_window_h_p       => t_window_h_1
8799              t_surf_green_h   => t_surf_green_h_2;  t_surf_green_h_p   => t_surf_green_h_1
8800              t_green_h        => t_green_h_2;       t_green_h_p        => t_green_h_1
8801!
8802!--          Vertical surfaces
8803              t_surf_wall_v    => t_surf_wall_v_2;   t_surf_wall_v_p    => t_surf_wall_v_1
8804              t_wall_v         => t_wall_v_2;        t_wall_v_p         => t_wall_v_1
8805              t_surf_window_v  => t_surf_window_v_2; t_surf_window_v_p  => t_surf_window_v_1
8806              t_window_v       => t_window_v_2;      t_window_v_p       => t_window_v_1
8807              t_surf_green_v   => t_surf_green_v_2;  t_surf_green_v_p   => t_surf_green_v_1
8808              t_green_v        => t_green_v_2;       t_green_v_p        => t_green_v_1
8809        END SELECT
8810         
8811     END SUBROUTINE usm_swap_timelevel
8812 
8813!------------------------------------------------------------------------------!
8814! Description:
8815! ------------
8816!> Subroutine writes t_surf and t_wall data into restart files
8817!------------------------------------------------------------------------------!
8818     SUBROUTINE usm_wrd_local
8819 
8820     
8821        IMPLICIT NONE
8822       
8823        CHARACTER(LEN=1) ::  dum     !< dummy string to create output-variable name 
8824        INTEGER(iwp)     ::  l       !< index surface type orientation
8825 
8826        CALL wrd_write_string( 'ns_h_on_file_usm' )
8827        WRITE ( 14 )  surf_usm_h%ns
8828 
8829        CALL wrd_write_string( 'ns_v_on_file_usm' )
8830        WRITE ( 14 )  surf_usm_v(0:3)%ns
8831 
8832        CALL wrd_write_string( 'usm_start_index_h' )
8833        WRITE ( 14 )  surf_usm_h%start_index
8834 
8835        CALL wrd_write_string( 'usm_end_index_h' )
8836        WRITE ( 14 )  surf_usm_h%end_index
8837 
8838        CALL wrd_write_string( 't_surf_wall_h' )
8839        WRITE ( 14 )  t_surf_wall_h
8840 
8841        CALL wrd_write_string( 't_surf_window_h' )
8842        WRITE ( 14 )  t_surf_window_h
8843 
8844        CALL wrd_write_string( 't_surf_green_h' )
8845        WRITE ( 14 )  t_surf_green_h
8846!
8847!--     Write restart data which is especially needed for the urban-surface
8848!--     model. In order to do not fill up the restart routines in
8849!--     surface_mod.
8850!--     Output of waste heat from indoor model. Restart data is required in
8851!--     this special case, because the indoor model where waste heat is
8852!--     computed is call each hour (current default), so that waste heat would
8853!--     have zero value until next call of indoor model.
8854        IF ( indoor_model )  THEN
8855           CALL wrd_write_string( 'waste_heat_h' )
8856           WRITE ( 14 )  surf_usm_h%waste_heat
8857        ENDIF   
8858           
8859        DO  l = 0, 3
8860 
8861           CALL wrd_write_string( 'usm_start_index_v' )
8862           WRITE ( 14 )  surf_usm_v(l)%start_index
8863 
8864           CALL wrd_write_string( 'usm_end_index_v' )
8865           WRITE ( 14 )  surf_usm_v(l)%end_index
8866 
8867           WRITE( dum, '(I1)')  l         
8868 
8869           CALL wrd_write_string( 't_surf_wall_v(' // dum // ')' )
8870           WRITE ( 14 )  t_surf_wall_v(l)%t
8871 
8872           CALL wrd_write_string( 't_surf_window_v(' // dum // ')' )
8873           WRITE ( 14 ) t_surf_window_v(l)%t     
8874 
8875           CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
8876           WRITE ( 14 ) t_surf_green_v(l)%t 
8877           
8878           IF ( indoor_model )  THEN
8879              CALL wrd_write_string( 'waste_heat_v(' // dum // ')' )
8880              WRITE ( 14 )  surf_usm_v(l)%waste_heat
8881           ENDIF
8882           
8883        ENDDO
8884 
8885        CALL wrd_write_string( 'usm_start_index_h' )
8886        WRITE ( 14 )  surf_usm_h%start_index
8887 
8888        CALL wrd_write_string( 'usm_end_index_h' )
8889        WRITE ( 14 )  surf_usm_h%end_index
8890 
8891        CALL wrd_write_string( 't_wall_h' )
8892        WRITE ( 14 )  t_wall_h
8893 
8894        CALL wrd_write_string( 't_window_h' )
8895        WRITE ( 14 )  t_window_h
8896 
8897        CALL wrd_write_string( 't_green_h' )
8898        WRITE ( 14 )  t_green_h
8899 
8900        DO  l = 0, 3
8901 
8902           CALL wrd_write_string( 'usm_start_index_v' )
8903           WRITE ( 14 )  surf_usm_v(l)%start_index
8904 
8905           CALL wrd_write_string( 'usm_end_index_v' )
8906           WRITE ( 14 )  surf_usm_v(l)%end_index
8907 
8908           WRITE( dum, '(I1)')  l     
8909 
8910           CALL wrd_write_string( 't_wall_v(' // dum // ')' )
8911           WRITE ( 14 )  t_wall_v(l)%t
8912 
8913           CALL wrd_write_string( 't_window_v(' // dum // ')' )
8914           WRITE ( 14 )  t_window_v(l)%t
8915 
8916           CALL wrd_write_string( 't_green_v(' // dum // ')' )
8917           WRITE ( 14 )  t_green_v(l)%t
8918       
8919        ENDDO
8920       
8921     END SUBROUTINE usm_wrd_local
8922     
8923     
8924!------------------------------------------------------------------------------!
8925! Description:
8926! ------------
8927!> Define building properties
8928!------------------------------------------------------------------------------!
8929     SUBROUTINE usm_define_pars     
8930!
8931!--     Define the building_pars
8932        building_pars(:,1) = (/   &
8933           0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
8934           0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
8935           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
8936           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
8937           1.5_wp,         &  !< parameter 4   - LAI roof
8938           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
8939           2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
8940           1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
8941           1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
8942           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
8943           0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
8944           2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
8945           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
8946           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
8947           0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
8948           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
8949           0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
8950           0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
8951           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
8952           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
8953           4.0_wp,         &  !< parameter 20  - ground floor level height
8954           0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
8955           0.25_wp,        &  !< parameter 22  - window fraction ground floor level
8956           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
8957           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
8958           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
8959           2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
8960           1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
8961           1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
8962           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
8963           0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
8964           2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
8965           0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
8966           0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
8967           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
8968           0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
8969           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
8970           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
8971           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
8972           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
8973           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
8974           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
8975           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
8976           0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
8977           0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
8978           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
8979           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
8980           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
8981           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
8982           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
8983           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
8984           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
8985           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
8986           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
8987           0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
8988           0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
8989           2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
8990           1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
8991           1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
8992           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
8993           0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
8994           2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
8995           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
8996           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
8997           0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
8998           0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
8999           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9000           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9001           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9002           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9003           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9004           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9005           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9006           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9007           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9008           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9009           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9010           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9011           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9012           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9013           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9014           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9015           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9016           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9017           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9018           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9019           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9020           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9021           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9022           1.0_wp,         &  !< parameter 89  - wall fraction roof
9023           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9024           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9025           0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9026           0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9027           2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9028           1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9029           1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9030           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9031           0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9032           2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9033           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9034           27.0_wp,        &  !< parameter 101 - wall albedo roof
9035           0.0_wp,         &  !< parameter 102 - window fraction roof
9036           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9037           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9038           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9039           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9040           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9041           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9042           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9043           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9044           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9045           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9046           0.91_wp,        &  !< parameter 113 - window emissivity roof
9047           0.75_wp,        &  !< parameter 114 - window transmissivity roof
9048           27.0_wp,        &  !< parameter 115 - window albedo roof
9049           0.86_wp,        &  !< parameter 116 - green emissivity roof
9050           5.0_wp,         &  !< parameter 117 - green albedo roof
9051           0.0_wp,         &  !< parameter 118 - green type roof
9052           0.8_wp,         &  !< parameter 119 - shading factor
9053           0.76_wp,        &  !< parameter 120 - g-value windows
9054           5.0_wp,         &  !< parameter 121 - u-value windows
9055           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9056           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9057           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9058           3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9059           370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9060           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9061           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9062           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9063           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9064           10.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9065           3.0_wp,         &  !< parameter 132 - storey height
9066           0.2_wp          &  !< parameter 133 - ceiling construction height
9067                            /)
9068                           
9069        building_pars(:,2) = (/   &
9070           0.73_wp,        &  !< parameter 0   - wall fraction above ground floor level
9071           0.27_wp,        &  !< parameter 1   - window fraction above ground floor level
9072           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9073           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9074           1.5_wp,         &  !< parameter 4   - LAI roof
9075           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9076           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9077           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9078           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9079           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9080           0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9081           0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9082           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9083           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9084           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9085           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9086           0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
9087           0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9088           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9089           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9090           4.0_wp,         &  !< parameter 20  - ground floor level height
9091           0.78_wp,        &  !< parameter 21  - wall fraction ground floor level
9092           0.22_wp,        &  !< parameter 22  - window fraction ground floor level
9093           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9094           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9095           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9096           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9097           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9098           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9099           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9100           0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9101           0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9102           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9103           0.11_wp,        &  !< parameter 33  - window emissivity ground floor level
9104           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9105           0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
9106           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9107           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9108           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9109           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9110           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9111           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9112           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9113           0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9114           0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9115           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9116           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9117           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9118           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9119           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9120           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9121           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9122           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9123           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9124           0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9125           0.42_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9126           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9127           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9128           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9129           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9130           0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9131           0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9132           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9133           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9134           0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9135           0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9136           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9137           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9138           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9139           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9140           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9141           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9142           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9143           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9144           0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9145           0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9146           0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9147           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9148           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9149           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9150           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9151           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9152           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9153           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9154           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9155           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9156           0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9157           0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9158           0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9159           1.0_wp,         &  !< parameter 89  - wall fraction roof
9160           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9161           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9162           0.5_wp,         &  !< parameter 92  - 3rd wall layer thickness roof
9163           0.79_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9164           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9165           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9166           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9167           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9168           0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9169           0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9170           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9171           27.0_wp,        &  !< parameter 101 - wall albedo roof
9172           0.0_wp,         &  !< parameter 102 - window fraction roof
9173           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9174           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9175           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9176           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9177           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9178           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9179           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9180           0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9181           0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9182           0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9183           0.87_wp,        &  !< parameter 113 - window emissivity roof
9184           0.7_wp,         &  !< parameter 114 - window transmissivity roof
9185           27.0_wp,        &  !< parameter 115 - window albedo roof
9186           0.86_wp,        &  !< parameter 116 - green emissivity roof
9187           5.0_wp,         &  !< parameter 117 - green albedo roof
9188           0.0_wp,         &  !< parameter 118 - green type roof
9189           0.8_wp,         &  !< parameter 119 - shading factor
9190           0.6_wp,         &  !< parameter 120 - g-value windows
9191           3.0_wp,         &  !< parameter 121 - u-value windows
9192           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9193           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9194           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9195           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9196           165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9197           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9198           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9199           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9200           4.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9201           8.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9202           3.0_wp,         &  !< parameter 132 - storey height
9203           0.2_wp          &  !< parameter 133 - ceiling construction height
9204                            /)
9205                           
9206        building_pars(:,3) = (/   &
9207           0.7_wp,         &  !< parameter 0   - wall fraction above ground floor level
9208           0.3_wp,         &  !< parameter 1   - window fraction above ground floor level
9209           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9210           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9211           1.5_wp,         &  !< parameter 4   - LAI roof
9212           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9213           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9214           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9215           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9216           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9217           0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9218           0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9219           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9220           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9221           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9222           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9223           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9224           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9225           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9226           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9227           4.0_wp,         &  !< parameter 20  - ground floor level height
9228           0.75_wp,        &  !< parameter 21  - wall fraction ground floor level
9229           0.25_wp,        &  !< parameter 22  - window fraction ground floor level
9230           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9231           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9232           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9233           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9234           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9235           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9236           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9237           0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9238           0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9239           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9240           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9241           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9242           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9243           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9244           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9245           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9246           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9247           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9248           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9249           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9250           0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9251           0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9252           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9253           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9254           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9255           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9256           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9257           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9258           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9259           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9260           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9261           0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9262           0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9263           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9264           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9265           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9266           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9267           0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9268           0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9269           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9270           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9271           0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9272           0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9273           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9274           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9275           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9276           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9277           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9278           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9279           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9280           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9281           0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9282           0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9283           0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9284           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9285           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9286           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9287           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9288           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9289           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9290           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9291           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9292           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9293           0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9294           0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9295           0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9296           1.0_wp,         &  !< parameter 89  - wall fraction roof
9297           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9298           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9299           0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9300           0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9301           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9302           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9303           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9304           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9305           0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9306           0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9307           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9308           27.0_wp,        &  !< parameter 101 - wall albedo roof
9309           0.0_wp,         &  !< parameter 102 - window fraction roof
9310           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9311           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9312           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9313           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9314           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9315           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9316           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9317           0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9318           0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9319           0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9320           0.8_wp,         &  !< parameter 113 - window emissivity roof
9321           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9322           27.0_wp,        &  !< parameter 115 - window albedo roof
9323           0.86_wp,        &  !< parameter 116 - green emissivity roof
9324           5.0_wp,         &  !< parameter 117 - green albedo roof
9325           0.0_wp,         &  !< parameter 118 - green type roof
9326           0.8_wp,         &  !< parameter 119 - shading factor
9327           0.5_wp,         &  !< parameter 120 - g-value windows
9328           0.6_wp,         &  !< parameter 121 - u-value windows
9329           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9330           0.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9331           0.8_wp,         &  !< parameter 124 - heat recovery efficiency
9332           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9333           80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9334           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9335           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9336           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9337           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9338           8.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9339           3.0_wp,         &  !< parameter 132 - storey height
9340           0.2_wp          &  !< parameter 133 - ceiling construction height
9341                            /)   
9342                           
9343        building_pars(:,4) = (/   &
9344           0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9345           0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9346           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9347           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9348           1.5_wp,         &  !< parameter 4   - LAI roof
9349           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9350           2200000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9351           1400000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9352           1300000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9353           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9354           0.8_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9355           2.1_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9356           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9357           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9358           0.93_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9359           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9360           0.91_wp,        &  !< parameter 16  - window emissivity above ground floor level
9361           0.75_wp,        &  !< parameter 17  - window transmissivity above ground floor level
9362           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9363           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9364           4.0_wp,         &  !< parameter 20  - ground floor level height
9365           0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9366           0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9367           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9368           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9369           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9370           2200000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9371           1400000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9372           1300000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9373           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9374           0.8_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9375           2.1_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9376           0.93_wp,        &  !< parameter 32  - wall emissivity ground floor level
9377           0.91_wp,        &  !< parameter 33  - window emissivity ground floor level
9378           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9379           0.75_wp,        &  !< parameter 35  - window transmissivity ground floor level
9380           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9381           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9382           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9383           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9384           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9385           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9386           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9387           0.39_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9388           0.63_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9389           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9390           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9391           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9392           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9393           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9394           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9395           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9396           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9397           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9398           0.39_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9399           0.63_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9400           2200000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9401           1400000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9402           1300000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9403           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9404           0.8_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9405           2.1_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9406           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9407           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9408           0.39_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9409           0.63_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9410           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9411           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9412           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9413           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9414           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9415           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9416           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9417           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9418           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9419           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9420           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9421           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9422           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9423           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9424           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9425           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9426           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9427           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9428           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9429           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9430           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9431           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9432           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9433           1.0_wp,         &  !< parameter 89  - wall fraction roof
9434           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9435           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9436           0.39_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9437           0.63_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9438           2200000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9439           1400000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9440           1300000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9441           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9442           0.8_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9443           2.1_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9444           0.93_wp,        &  !< parameter 100 - wall emissivity roof
9445           27.0_wp,        &  !< parameter 101 - wall albedo roof
9446           0.0_wp,         &  !< parameter 102 - window fraction roof
9447           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9448           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9449           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9450           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9451           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9452           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9453           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9454           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9455           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9456           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9457           0.91_wp,        &  !< parameter 113 - window emissivity roof
9458           0.75_wp,        &  !< parameter 114 - window transmissivity roof
9459           27.0_wp,        &  !< parameter 115 - window albedo roof
9460           0.86_wp,        &  !< parameter 116 - green emissivity roof
9461           5.0_wp,         &  !< parameter 117 - green albedo roof
9462           0.0_wp,         &  !< parameter 118 - green type roof
9463           0.8_wp,         &  !< parameter 119 - shading factor
9464           0.76_wp,        &  !< parameter 120 - g-value windows
9465           5.0_wp,         &  !< parameter 121 - u-value windows
9466           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9467           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9468           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9469           3.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9470           370000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9471           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9472           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9473           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9474           3.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9475           10.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9476           3.0_wp,         &  !< parameter 132 - storey height
9477           0.2_wp          &  !< parameter 133 - ceiling construction height
9478                            /)   
9479                           
9480        building_pars(:,5) = (/   &
9481           0.5_wp,         &  !< parameter 0   - wall fraction above ground floor level
9482           0.5_wp,         &  !< parameter 1   - window fraction above ground floor level
9483           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9484           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9485           1.5_wp,         &  !< parameter 4   - LAI roof
9486           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9487           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9488           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9489           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9490           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9491           0.38_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9492           0.04_wp,        &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9493           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9494           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9495           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9496           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9497           0.87_wp,        &  !< parameter 16  - window emissivity above ground floor level
9498           0.7_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9499           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9500           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9501           4.0_wp,         &  !< parameter 20  - ground floor level height
9502           0.55_wp,        &  !< parameter 21  - wall fraction ground floor level
9503           0.45_wp,        &  !< parameter 22  - window fraction ground floor level
9504           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9505           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9506           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9507           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9508           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9509           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9510           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9511           0.38_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9512           0.04_wp,        &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9513           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9514           0.87_wp,        &  !< parameter 33  - window emissivity ground floor level
9515           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9516           0.7_wp,         &  !< parameter 35  - window transmissivity ground floor level
9517           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9518           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9519           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9520           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9521           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9522           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9523           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9524           0.31_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9525           0.43_wp,        &  !< parameter 44  - 4th wall layer thickness above ground floor level
9526           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9527           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9528           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9529           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9530           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9531           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9532           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9533           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9534           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9535           0.31_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9536           0.43_wp,        &  !< parameter 55  - 4th wall layer thickness ground plate
9537           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9538           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9539           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9540           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9541           0.38_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9542           0.04_wp,        &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9543           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9544           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9545           0.31_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9546           0.43_wp,        &  !< parameter 65  - 4th wall layer thickness ground floor level
9547           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9548           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9549           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9550           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9551           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9552           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9553           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9554           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9555           0.11_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9556           0.11_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9557           0.11_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9558           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9559           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9560           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9561           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9562           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9563           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9564           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9565           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9566           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9567           0.11_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9568           0.11_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9569           0.11_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9570           1.0_wp,         &  !< parameter 89  - wall fraction roof
9571           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9572           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9573           0.31_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9574           0.43_wp,        &  !< parameter 93  - 4th wall layer thickness roof
9575           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9576           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9577           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9578           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9579           0.38_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9580           0.04_wp,        &  !< parameter 99  - thermal conductivity 4th wall layer roof
9581           0.91_wp,        &  !< parameter 100 - wall emissivity roof
9582           27.0_wp,        &  !< parameter 101 - wall albedo roof
9583           0.0_wp,         &  !< parameter 102 - window fraction roof
9584           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9585           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9586           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9587           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9588           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9589           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9590           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9591           0.11_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9592           0.11_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9593           0.11_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9594           0.87_wp,        &  !< parameter 113 - window emissivity roof
9595           0.7_wp,         &  !< parameter 114 - window transmissivity roof
9596           27.0_wp,        &  !< parameter 115 - window albedo roof
9597           0.86_wp,        &  !< parameter 116 - green emissivity roof
9598           5.0_wp,         &  !< parameter 117 - green albedo roof
9599           0.0_wp,         &  !< parameter 118 - green type roof
9600           0.8_wp,         &  !< parameter 119 - shading factor
9601           0.6_wp,         &  !< parameter 120 - g-value windows
9602           3.0_wp,         &  !< parameter 121 - u-value windows
9603           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9604           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9605           0.65_wp,        &  !< parameter 124 - heat recovery efficiency
9606           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9607           165000.0_wp,    &  !< parameter 126 - dynamic parameter innner heatstorage
9608           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9609           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9610           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9611           7.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9612           20.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9613           3.0_wp,         &  !< parameter 132 - storey height
9614           0.2_wp          &  !< parameter 133 - ceiling construction height
9615                            /)
9616                           
9617        building_pars(:,6) = (/   &
9618           0.425_wp,       &  !< parameter 0   - wall fraction above ground floor level
9619           0.575_wp,       &  !< parameter 1   - window fraction above ground floor level
9620           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9621           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9622           1.5_wp,         &  !< parameter 4   - LAI roof
9623           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9624           2000000.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9625           103000.0_wp,    &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9626           900000.0_wp,    &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9627           0.35_wp,        &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9628           0.14_wp,        &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9629           0.035_wp,       &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9630           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9631           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9632           0.92_wp,        &  !< parameter 14  - wall emissivity above ground floor level
9633           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9634           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9635           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9636           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9637           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9638           4.0_wp,         &  !< parameter 20  - ground floor level height
9639           0.475_wp,       &  !< parameter 21  - wall fraction ground floor level
9640           0.525_wp,       &  !< parameter 22  - window fraction ground floor level
9641           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9642           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9643           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9644           2000000.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9645           103000.0_wp,    &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9646           900000.0_wp,    &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9647           0.35_wp,        &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9648           0.14_wp,        &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9649           0.035_wp,       &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9650           0.92_wp,        &  !< parameter 32  - wall emissivity ground floor level
9651           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9652           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9653           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9654           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9655           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9656           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9657           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9658           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9659           0.005_wp,       &  !< parameter 41  - 1st wall layer thickness above ground floor level
9660           0.01_wp,        &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9661           0.41_wp,        &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9662           0.7_wp,         &  !< parameter 44  - 4th wall layer thickness above ground floor level
9663           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9664           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9665           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9666           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9667           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9668           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9669           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9670           0.005_wp,       &  !< parameter 52  - 1st wall layer thickness ground plate
9671           0.01_wp,        &  !< parameter 53  - 2nd wall layer thickness ground plate
9672           0.41_wp,        &  !< parameter 54  - 3rd wall layer thickness ground plate
9673           0.7_wp,         &  !< parameter 55  - 4th wall layer thickness ground plate
9674           2000000.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9675           103000.0_wp,    &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9676           900000.0_wp,    &  !< parameter 58  - heat capacity 4th wall layer ground plate
9677           0.35_wp,        &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9678           0.14_wp,        &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9679           0.035_wp,       &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9680           0.005_wp,       &  !< parameter 62  - 1st wall layer thickness ground floor level
9681           0.01_wp,        &  !< parameter 63  - 2nd wall layer thickness ground floor level
9682           0.41_wp,        &  !< parameter 64  - 3rd wall layer thickness ground floor level
9683           0.7_wp,         &  !< parameter 65  - 4th wall layer thickness ground floor level
9684           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9685           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9686           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9687           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9688           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9689           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9690           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9691           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9692           0.037_wp,       &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9693           0.037_wp,       &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9694           0.037_wp,       &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9695           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9696           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9697           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9698           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9699           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9700           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9701           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9702           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9703           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9704           0.037_wp,       &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9705           0.037_wp,       &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9706           0.037_wp,       &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9707           1.0_wp,         &  !< parameter 89  - wall fraction roof
9708           0.005_wp,       &  !< parameter 90  - 1st wall layer thickness roof
9709           0.01_wp,        &  !< parameter 91  - 2nd wall layer thickness roof
9710           0.41_wp,        &  !< parameter 92  - 3rd wall layer thickness roof
9711           0.7_wp,         &  !< parameter 93  - 4th wall layer thickness roof
9712           2000000.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9713           103000.0_wp,    &  !< parameter 95  - heat capacity 3rd wall layer roof
9714           900000.0_wp,    &  !< parameter 96  - heat capacity 4th wall layer roof
9715           0.35_wp,        &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9716           0.14_wp,        &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9717           0.035_wp,       &  !< parameter 99  - thermal conductivity 4th wall layer roof
9718           0.91_wp,        &  !< parameter 100 - wall emissivity roof
9719           27.0_wp,        &  !< parameter 101 - wall albedo roof
9720           0.0_wp,         &  !< parameter 102 - window fraction roof
9721           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9722           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9723           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9724           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9725           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9726           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9727           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9728           0.037_wp,       &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9729           0.037_wp,       &  !< parameter 111 - thermal conductivity 3rd window layer roof
9730           0.037_wp,       &  !< parameter 112 - thermal conductivity 4th window layer roof
9731           0.8_wp,         &  !< parameter 113 - window emissivity roof
9732           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9733           27.0_wp,        &  !< parameter 115 - window albedo roof
9734           0.86_wp,        &  !< parameter 116 - green emissivity roof
9735           5.0_wp,         &  !< parameter 117 - green albedo roof
9736           0.0_wp,         &  !< parameter 118 - green type roof
9737           0.8_wp,         &  !< parameter 119 - shading factor
9738           0.5_wp,         &  !< parameter 120 - g-value windows
9739           0.6_wp,         &  !< parameter 121 - u-value windows
9740           0.1_wp,         &  !< parameter 122 - basical airflow without occupancy of the room
9741           1.5_wp,         &  !< parameter 123 - additional airflow depend of occupancy of the room
9742           0.9_wp,         &  !< parameter 124 - heat recovery efficiency
9743           2.5_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9744           80000.0_wp,     &  !< parameter 126 - dynamic parameter innner heatstorage
9745           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9746           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9747           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9748           5.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9749           15.0_wp,        &  !< parameter 131 - basic internal heat gains without occupancy of the room
9750           3.0_wp,         &  !< parameter 132 - storey height
9751           0.2_wp          &  !< parameter 133 - ceiling construction height
9752                            /)
9753                           
9754        building_pars(:,7) = (/   &
9755           1.0_wp,         &  !< parameter 0   - wall fraction above ground floor level
9756           0.0_wp,         &  !< parameter 1   - window fraction above ground floor level
9757           0.0_wp,         &  !< parameter 2   - green fraction above ground floor level
9758           0.0_wp,         &  !< parameter 3   - green fraction roof above ground floor level
9759           1.5_wp,         &  !< parameter 4   - LAI roof
9760           1.5_wp,         &  !< parameter 5   - LAI on wall above ground floor level
9761           1950400.0_wp,   &  !< parameter 6   - heat capacity 1st/2nd wall layer above ground floor level
9762           1848000.0_wp,   &  !< parameter 7   - heat capacity 3rd wall layer above ground floor level
9763           1848000.0_wp,   &  !< parameter 8   - heat capacity 4th wall layer above ground floor level
9764           0.7_wp,         &  !< parameter 9   - thermal conductivity 1st/2nd wall layer above ground floor level
9765           1.0_wp,         &  !< parameter 10  - thermal conductivity 3rd wall layer above ground floor level
9766           1.0_wp,         &  !< parameter 11  - thermal conductivity 4th wall layer above ground floor level
9767           299.15_wp,      &  !< parameter 12  - indoor target summer temperature
9768           293.15_wp,      &  !< parameter 13  - indoor target winter temperature
9769           0.9_wp,         &  !< parameter 14  - wall emissivity above ground floor level
9770           0.86_wp,        &  !< parameter 15  - green emissivity above ground floor level
9771           0.8_wp,         &  !< parameter 16  - window emissivity above ground floor level
9772           0.6_wp,         &  !< parameter 17  - window transmissivity above ground floor level
9773           0.001_wp,       &  !< parameter 18  - z0 roughness above ground floor level
9774           0.0001_wp,      &  !< parameter 19  - z0h/z0g roughness heat/humidity above ground floor level
9775           4.0_wp,         &  !< parameter 20  - ground floor level height
9776           1.0_wp,         &  !< parameter 21  - wall fraction ground floor level
9777           0.0_wp,         &  !< parameter 22  - window fraction ground floor level
9778           0.0_wp,         &  !< parameter 23  - green fraction ground floor level
9779           0.0_wp,         &  !< parameter 24  - green fraction roof ground floor level
9780           1.5_wp,         &  !< parameter 25  - LAI on wall ground floor level
9781           1950400.0_wp,   &  !< parameter 26  - heat capacity 1st/2nd wall layer ground floor level
9782           1848000.0_wp,   &  !< parameter 27  - heat capacity 3rd wall layer ground floor level
9783           1848000.0_wp,   &  !< parameter 28  - heat capacity 4th wall layer ground floor level
9784           0.7_wp,         &  !< parameter 29  - thermal conductivity 1st/2nd wall layer ground floor level
9785           1.0_wp,         &  !< parameter 30  - thermal conductivity 3rd wall layer ground floor level
9786           1.0_wp,         &  !< parameter 31  - thermal conductivity 4th wall layer ground floor level
9787           0.9_wp,         &  !< parameter 32  - wall emissivity ground floor level
9788           0.8_wp,         &  !< parameter 33  - window emissivity ground floor level
9789           0.86_wp,        &  !< parameter 34  - green emissivity ground floor level
9790           0.6_wp,         &  !< parameter 35  - window transmissivity ground floor level
9791           0.001_wp,       &  !< parameter 36  - z0 roughness ground floor level
9792           0.0001_wp,      &  !< parameter 37  - z0h/z0q roughness heat/humidity
9793           27.0_wp,        &  !< parameter 38  - wall albedo above ground floor level
9794           5.0_wp,         &  !< parameter 39  - green albedo above ground floor level
9795           27.0_wp,        &  !< parameter 40  - window albedo above ground floor level
9796           0.29_wp,        &  !< parameter 41  - 1st wall layer thickness above ground floor level
9797           0.295_wp,       &  !< parameter 42  - 2nd wall layer thickness above ground floor level
9798           0.695_wp,       &  !< parameter 43  - 3rd wall layer thickness above ground floor level
9799           0.985_wp,       &  !< parameter 44  - 4th wall layer thickness above ground floor level
9800           20000.0_wp,     &  !< parameter 45  - heat capacity wall surface
9801           23.0_wp,        &  !< parameter 46  - thermal conductivity of wall surface
9802           20000.0_wp,     &  !< parameter 47  - heat capacity of window surface
9803           20000.0_wp,     &  !< parameter 48  - heat capacity of green surface
9804           23.0_wp,        &  !< parameter 49  - thermal conductivity of window surface
9805           10.0_wp,        &  !< parameter 50  - thermal conductivty of green surface
9806           1.0_wp,         &  !< parameter 51  - wall fraction ground plate
9807           0.29_wp,        &  !< parameter 52  - 1st wall layer thickness ground plate
9808           0.295_wp,       &  !< parameter 53  - 2nd wall layer thickness ground plate
9809           0.695_wp,       &  !< parameter 54  - 3rd wall layer thickness ground plate
9810           0.985_wp,       &  !< parameter 55  - 4th wall layer thickness ground plate
9811           1950400.0_wp,   &  !< parameter 56  - heat capacity 1st/2nd wall layer ground plate
9812           1848000.0_wp,   &  !< parameter 57  - heat capacity 3rd wall layer ground plate
9813           1848000.0_wp,   &  !< parameter 58  - heat capacity 4th wall layer ground plate
9814           0.7_wp,         &  !< parameter 59  - thermal conductivity 1st/2nd wall layer ground plate
9815           1.0_wp,         &  !< parameter 60  - thermal conductivity 3rd wall layer ground plate
9816           1.0_wp,         &  !< parameter 61  - thermal conductivity 4th wall layer ground plate
9817           0.29_wp,        &  !< parameter 62  - 1st wall layer thickness ground floor level
9818           0.295_wp,       &  !< parameter 63  - 2nd wall layer thickness ground floor level
9819           0.695_wp,       &  !< parameter 64  - 3rd wall layer thickness ground floor level
9820           0.985_wp,       &  !< parameter 65  - 4th wall layer thickness ground floor level
9821           27.0_wp,        &  !< parameter 66  - wall albedo ground floor level
9822           0.003_wp,       &  !< parameter 67  - 1st window layer thickness ground floor level
9823           0.006_wp,       &  !< parameter 68  - 2nd window layer thickness ground floor level
9824           0.012_wp,       &  !< parameter 69  - 3rd window layer thickness ground floor level
9825           0.018_wp,       &  !< parameter 70  - 4th window layer thickness ground floor level
9826           1736000.0_wp,   &  !< parameter 71  - heat capacity 1st/2nd window layer ground floor level
9827           1736000.0_wp,   &  !< parameter 72  - heat capacity 3rd window layer ground floor level
9828           1736000.0_wp,   &  !< parameter 73  - heat capacity 4th window layer ground floor level
9829           0.57_wp,        &  !< parameter 74  - thermal conductivity 1st/2nd window layer ground floor level
9830           0.57_wp,        &  !< parameter 75  - thermal conductivity 3rd window layer ground floor level
9831           0.57_wp,        &  !< parameter 76  - thermal conductivity 4th window layer ground floor level
9832           27.0_wp,        &  !< parameter 77  - window albedo ground floor level
9833           5.0_wp,         &  !< parameter 78  - green albedo ground floor level
9834           0.003_wp,       &  !< parameter 79  - 1st window layer thickness above ground floor level
9835           0.006_wp,       &  !< parameter 80  - 2nd thickness window layer above ground floor level
9836           0.012_wp,       &  !< parameter 81  - 3rd window layer thickness above ground floor level
9837           0.018_wp,       &  !< parameter 82  - 4th window layer thickness above ground floor level
9838           1736000.0_wp,   &  !< parameter 83  - heat capacity 1st/2nd window layer above ground floor level
9839           1736000.0_wp,   &  !< parameter 84  - heat capacity 3rd window layer above ground floor level
9840           1736000.0_wp,   &  !< parameter 85  - heat capacity 4th window layer above ground floor level
9841           0.57_wp,        &  !< parameter 86  - thermal conductivity 1st/2nd window layer above ground floor level
9842           0.57_wp,        &  !< parameter 87  - thermal conductivity 3rd window layer above ground floor level
9843           0.57_wp,        &  !< parameter 88  - thermal conductivity 4th window layer above ground floor level
9844           1.0_wp,         &  !< parameter 89  - wall fraction roof
9845           0.29_wp,        &  !< parameter 90  - 1st wall layer thickness roof
9846           0.295_wp,       &  !< parameter 91  - 2nd wall layer thickness roof
9847           0.695_wp,       &  !< parameter 92  - 3rd wall layer thickness roof
9848           0.985_wp,       &  !< parameter 93  - 4th wall layer thickness roof
9849           1950400.0_wp,   &  !< parameter 94  - heat capacity 1st/2nd wall layer roof
9850           1848000.0_wp,   &  !< parameter 95  - heat capacity 3rd wall layer roof
9851           1848000.0_wp,   &  !< parameter 96  - heat capacity 4th wall layer roof
9852           0.7_wp,         &  !< parameter 97  - thermal conductivity 1st/2nd wall layer roof
9853           1.0_wp,         &  !< parameter 98  - thermal conductivity 3rd wall layer roof
9854           1.0_wp,         &  !< parameter 99  - thermal conductivity 4th wall layer roof
9855           0.9_wp,         &  !< parameter 100 - wall emissivity roof
9856           27.0_wp,        &  !< parameter 101 - wall albedo roof
9857           0.0_wp,         &  !< parameter 102 - window fraction roof
9858           0.003_wp,       &  !< parameter 103 - window 1st layer thickness roof
9859           0.006_wp,       &  !< parameter 104 - window 2nd layer thickness roof
9860           0.012_wp,       &  !< parameter 105 - window 3rd layer thickness roof
9861           0.018_wp,       &  !< parameter 106 - window 4th layer thickness roof
9862           1736000.0_wp,   &  !< parameter 107 - heat capacity 1st/2nd window layer roof
9863           1736000.0_wp,   &  !< parameter 108 - heat capacity 3rd window layer roof
9864           1736000.0_wp,   &  !< parameter 109 - heat capacity 4th window layer roof
9865           0.57_wp,        &  !< parameter 110 - thermal conductivity 1st/2nd window layer roof
9866           0.57_wp,        &  !< parameter 111 - thermal conductivity 3rd window layer roof
9867           0.57_wp,        &  !< parameter 112 - thermal conductivity 4th window layer roof
9868           0.8_wp,         &  !< parameter 113 - window emissivity roof
9869           0.6_wp,         &  !< parameter 114 - window transmissivity roof
9870           27.0_wp,        &  !< parameter 115 - window albedo roof
9871           0.86_wp,        &  !< parameter 116 - green emissivity roof
9872           5.0_wp,         &  !< parameter 117 - green albedo roof
9873           0.0_wp,         &  !< parameter 118 - green type roof
9874           0.8_wp,         &  !< parameter 119 - shading factor
9875           100.0_wp,       &  !< parameter 120 - g-value windows
9876           100.0_wp,       &  !< parameter 121 - u-value windows
9877           20.0_wp,        &  !< parameter 122 - basical airflow without occupancy of the room
9878           20.0_wp,        &  !< parameter 123 - additional airflow depend of occupancy of the room
9879           0.0_wp,         &  !< parameter 124 - heat recovery efficiency
9880           1.0_wp,         &  !< parameter 125 - dynamic parameter specific effective surface
9881           1.0_wp,         &  !< parameter 126 - dynamic parameter innner heatstorage
9882           4.5_wp,         &  !< parameter 127 - ratio internal surface/floor area
9883           100000.0_wp,    &  !< parameter 128 - maximal heating capacity
9884           0.0_wp,         &  !< parameter 129 - maximal cooling capacity
9885           0.0_wp,         &  !< parameter 130 - additional internal heat gains dependent on occupancy of the room
9886           0.0_wp,         &  !< parameter 131 - basic internal heat gains without occupancy of the room
9887           3.0_wp,         &  !< parameter 132 - storey height
9888           0.2_wp          &  !< parameter 133 - ceiling construction height
9889                        /)
9890                       
9891     END SUBROUTINE usm_define_pars
9892 
9893   
9894  END MODULE urban_surface_mod
Note: See TracBrowser for help on using the repository browser.