Home

Context Navigation

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

Last change on this file since 3176 was 3176, checked in by suehring, 7 years ago
Major bugfix in calculation of ol and ts at building roofs; bugfix in restart data for surface elements; in 2D data output, mask latent heat flux at urban-type surfaces
Property svn:keywords set to `Id`
File size: 431.9 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-2018 Czech Technical University in Prague
18	! Copyright 2015-2018 Institute of Computer Science of the
19	! Czech Academy of Sciences, Prague
20	! Copyright 1997-2018 Leibniz Universitaet Hannover
21	!------------------------------------------------------------------------------!
22	!
23	! Current revisions:
24	! ------------------
25	!
26	!
27	! Former revisions:
28	! -----------------
29	! $Id: urban_surface_mod.f90 3176 2018-07-26 17:12:48Z suehring $
30	! Bugfix, update virtual potential surface temparture, else heat fluxes on
31	! roofs might become unphysical
32	!
33	! 3152 2018-07-19 13:26:52Z suehring
34	! Initialize q_surface, which might be used in surface_layer_fluxes
35	!
36	! 3151 2018-07-19 08:45:38Z raasch
37	! remaining preprocessor define strings __check removed
38	!
39	! 3136 2018-07-16 14:48:21Z suehring
40	! Limit also roughness length for heat and moisture where necessary
41	!
42	! 3123 2018-07-12 16:21:53Z suehring
43	! Correct working precision for INTEGER number
44	!
45	! 3115 2018-07-10 12:49:26Z suehring
46	! Additional building type to represent bridges
47	!
48	! 3091 2018-06-28 16:20:35Z suehring
49	! - Limit aerodynamic resistance at vertical walls.
50	! - Add check for local roughness length not exceeding surface-layer height and
51	! limit roughness length where necessary.
52	!
53	! 3065 2018-06-12 07:03:02Z Giersch
54	! Unused array dxdir was removed, dz was replaced by dzu to consider vertical
55	! grid stretching
56	!
57	! 3049 2018-05-29 13:52:36Z Giersch
58	! Error messages revised
59	!
60	! 3045 2018-05-28 07:55:41Z Giersch
61	! Error message added
62	!
63	! 3029 2018-05-23 12:19:17Z raasch
64	! bugfix: close unit 151 instead of 90
65	!
66	! 3014 2018-05-09 08:42:38Z maronga
67	! Added pc_transpiration_rate
68	!
69	! 2977 2018-04-17 10:27:57Z kanani
70	! Implement changes from branch radiation (r2948-2971) with minor modifications.
71	! (moh.hefny):
72	! Extended exn for all model domain height to avoid the need to get nzut.
73	!
74	! 2963 2018-04-12 14:47:44Z suehring
75	! Introduce index for vegetation/wall, pavement/green-wall and water/window
76	! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
77	!
78	! 2943 2018-04-03 16:17:10Z suehring
79	! Calculate exner function at all height levels and remove some un-used
80	! variables.
81	!
82	! 2932 2018-03-26 09:39:22Z maronga
83	! renamed urban_surface_par to urban_surface_parameters
84	!
85	! 2921 2018-03-22 15:05:23Z Giersch
86	! The activation of spinup has been moved to parin
87	!
88	! 2920 2018-03-22 11:22:01Z kanani
89	! Remove unused pcbl, npcbl from ONLY list
90	! moh.hefny:
91	! Fixed bugs introduced by new structures and by moving radiation interaction
92	! into radiation_model_mod.f90.
93	! Bugfix: usm data output 3D didn't respect directions
94	!
95	! 2906 2018-03-19 08:56:40Z Giersch
96	! Local variable ids has to be initialized with a value of -1 in
97	! usm_average_3d_data
98	!
99	! 2894 2018-03-15 09:17:58Z Giersch
100	! Calculations of the index range of the subdomain on file which overlaps with
101	! the current subdomain are already done in read_restart_data_mod,
102	! usm_read/write_restart_data have been renamed to usm_r/wrd_local, variable
103	! named found has been introduced for checking if restart data was found,
104	! reading of restart strings has been moved completely to
105	! read_restart_data_mod, usm_rrd_local is already inside the overlap loop
106	! programmed in read_restart_data_mod, SAVE attribute added where necessary,
107	! deallocation and allocation of some arrays have been changed to take care of
108	! different restart files that can be opened (index i), the marker *** end usm
109	! *** is not necessary anymore, strings and their respective lengths are
110	! written out and read now in case of restart runs to get rid of prescribed
111	! character lengths
112	!
113	! 2805 2018-02-14 17:00:09Z suehring
114	! Initialization of resistances.
115	!
116	! 2797 2018-02-08 13:24:35Z suehring
117	! Comment concerning output of ground-heat flux added.
118	!
119	! 2766 2018-01-22 17:17:47Z kanani
120	! Removed redundant commas, added some blanks
121	!
122	! 2765 2018-01-22 11:34:58Z maronga
123	! Major bugfix in calculation of f_shf. Adjustment of roughness lengths in
124	! building_pars
125	!
126	! 2750 2018-01-15 16:26:51Z knoop
127	! Move flag plant canopy to modules
128	!
129	! 2737 2018-01-11 14:58:11Z kanani
130	! Removed unused variables t_surf_whole...
131	!
132	! 2735 2018-01-11 12:01:27Z suehring
133	! resistances are saved in surface attributes
134	!
135	! 2723 2018-01-05 09:27:03Z maronga
136	! Bugfix for spinups (end_time was increased twice in case of LSM + USM runs)
137	!
138	! 2720 2018-01-02 16:27:15Z kanani
139	! Correction of comment
140	!
141	! 2718 2018-01-02 08:49:38Z maronga
142	! Corrected "Former revisions" section
143	!
144	! 2705 2017-12-18 11:26:23Z maronga
145	! Changes from last commit documented
146	!
147	! 2703 2017-12-15 20:12:38Z maronga
148	! Workaround for calculation of r_a
149	!
150	! 2696 2017-12-14 17:12:51Z kanani
151	! - Change in file header (GPL part)
152	! - Bugfix in calculation of pt_surface and related fluxes. (BM)
153	! - Do not write surface temperatures onto pt array as this might cause
154	! problems with nesting. (MS)
155	! - Revised calculation of pt1 (now done in surface_layer_fluxes).
156	! Bugfix, f_shf_window and f_shf_green were not set at vertical surface
157	! elements. (MS)
158	! - merged with branch ebsolver
159	! green building surfaces do not evaporate yet
160	! properties of green wall layers and window layers are taken from wall layers
161	! this input data is missing. (RvT)
162	! - Merged with branch radiation (developed by Mohamed Salim)
163	! - Revised initialization. (MS)
164	! - Rename emiss_surf into emissivity, roughness_wall into z0, albedo_surf into
165	! albedo. (MS)
166	! - Move first call of usm_radiatin from usm_init to init_3d_model
167	! - fixed problem with near surface temperature
168	! - added near surface temperature t_surf_10cm_h(m), t_surf_10cm_v(l)%t(m)
169	! - does not work with temp profile including stability, ol
170	! t_surf_10cm = pt1 now
171	! - merged with 2357 bugfix, error message for nopointer version
172	! - added indoor model coupling with wall heat flux
173	! - added green substrate/ dry vegetation layer for buildings
174	! - merged with 2232 new surface-type structure
175	! - added transmissivity of window tiles
176	! - added MOSAIK tile approach for 3 different surfaces (RvT)
177	!
178	! 2583 2017-10-26 13:58:38Z knoop
179	! Bugfix: reverted MPI_Win_allocate_cptr introduction in last commit
180	!
181	! 2582 2017-10-26 13:19:46Z hellstea
182	! Workaround for gnufortran compiler added in usm_calc_svf. CALL MPI_Win_allocate is
183	! replaced by CALL MPI_Win_allocate_cptr if defined ( __gnufortran ).
184	!
185	! 2544 2017-10-13 18:09:32Z maronga
186	! Date and time quantities are now read from date_and_time_mod. Solar constant is
187	! read from radiation_model_mod
188	!
189	! 2516 2017-10-04 11:03:04Z suehring
190	! Remove tabs
191	!
192	! 2514 2017-10-04 09:52:37Z suehring
193	! upper bounds of 3d output changed from nx+1,ny+1 to nx,ny
194	! no output of ghost layer data
195	!
196	! 2350 2017-08-15 11:48:26Z kanani
197	! Bugfix and error message for nopointer version.
198	! Additional "! defined(__nopointer)" as workaround to enable compilation of
199	! nopointer version.
200	!
201	! 2318 2017-07-20 17:27:44Z suehring
202	! Get topography top index via Function call
203	!
204	! 2317 2017-07-20 17:27:19Z suehring
205	! Bugfix: adjust output of shf. Added support for spinups
206	!
207	! 2287 2017-06-15 16:46:30Z suehring
208	! Bugfix in determination topography-top index
209	!
210	! 2269 2017-06-09 11:57:32Z suehring
211	! Enable restart runs with different number of PEs
212	! Bugfixes nopointer branch
213	!
214	! 2258 2017-06-08 07:55:13Z suehring
215	! Bugfix, add pre-preprocessor directives to enable non-parrallel mode
216	!
217	! 2233 2017-05-30 18:08:54Z suehring
218	!
219	! 2232 2017-05-30 17:47:52Z suehring
220	! Adjustments according to new surface-type structure. Remove usm_wall_heat_flux;
221	! insteat, heat fluxes are directly applied in diffusion_s.
222	!
223	! 2213 2017-04-24 15:10:35Z kanani
224	! Removal of output quantities usm_lad and usm_canopy_hr
225	!
226	! 2209 2017-04-19 09:34:46Z kanani
227	! cpp switch __mpi3 removed,
228	! minor formatting,
229	! small bugfix for division by zero (Krc)
230	!
231	! 2113 2017-01-12 13:40:46Z kanani
232	! cpp switch __mpi3 added for MPI-3 standard code (Ketelsen)
233	!
234	! 2071 2016-11-17 11:22:14Z maronga
235	! Small bugfix (Resler)
236	!
237	! 2031 2016-10-21 15:11:58Z knoop
238	! renamed variable rho to rho_ocean
239	!
240	! 2024 2016-10-12 16:42:37Z kanani
241	! Bugfixes in deallocation of array plantt and reading of csf/csfsurf,
242	! optimization of MPI-RMA operations,
243	! declaration of pcbl as integer,
244	! renamed usm_radnet -> usm_rad_net, usm_canopy_khf -> usm_canopy_hr,
245	! splitted arrays svf -> svf & csf, svfsurf -> svfsurf & csfsurf,
246	! use of new control parameter varnamelength,
247	! added output variables usm_rad_ressw, usm_rad_reslw,
248	! minor formatting changes,
249	! minor optimizations.
250	!
251	! 2011 2016-09-19 17:29:57Z kanani
252	! Major reformatting according to PALM coding standard (comments, blanks,
253	! alphabetical ordering, etc.),
254	! removed debug_prints,
255	! removed auxiliary SUBROUTINE get_usm_info, instead, USM flag urban_surface is
256	! defined in MODULE control_parameters (modules.f90) to avoid circular
257	! dependencies,
258	! renamed canopy_heat_flux to pc_heating_rate, as meaning of quantity changed.
259	!
260	! 2007 2016-08-24 15:47:17Z kanani
261	! Initial revision
262	!
263	!
264	! Description:
265	! ------------
266	! 2016/6/9 - Initial version of the USM (Urban Surface Model)
267	! authors: Jaroslav Resler, Pavel Krc
268	! (Czech Technical University in Prague and Institute of
269	! Computer Science of the Czech Academy of Sciences, Prague)
270	! with contributions: Michal Belda, Nina Benesova, Ondrej Vlcek
271	! partly inspired by PALM LSM (B. Maronga)
272	! parameterizations of Ra checked with TUF3D (E. S. Krayenhoff)
273	!> Module for Urban Surface Model (USM)
274	!> The module includes:
275	!> 1. radiation model with direct/diffuse radiation, shading, reflections
276	!> and integration with plant canopy
277	!> 2. wall and wall surface model
278	!> 3. surface layer energy balance
279	!> 4. anthropogenic heat (only from transportation so far)
280	!> 5. necessary auxiliary subroutines (reading inputs, writing outputs,
281	!> restart simulations, ...)
282	!> It also make use of standard radiation and integrates it into
283	!> urban surface model.
284	!>
285	!> Further work:
286	!> -------------
287	!> 1. Remove global arrays surfouts, surfoutl and only keep track of radiosity
288	!> from surfaces that are visible from local surfaces (i.e. there is a SVF
289	!> where target is local). To do that, radiosity will be exchanged after each
290	!> reflection step using MPI_Alltoall instead of current MPI_Allgather.
291	!>
292	!> 2. Temporarily large values of surface heat flux can be observed, up to
293	!> 1.2 Km/s, which seem to be not realistic.
294	!>
295	!> @todo Output of _av variables in case of restarts
296	!> @todo Revise flux conversion in energy-balance solver
297	!> @todo Bugfixing in nopointer branch
298	!> @todo Check optimizations for RMA operations
299	!> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi)
300	!> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
301	!> factor 3 between min and max time
302	!> @todo Move setting of flag indoor_model to indoor_model_mod once available
303	!> @todo Check divisions in wtend (etc.) calculations for possible division
304	!> by zero, e.g. in case fraq(0,m) + fraq(1,m) = 0?!
305	!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
306	!> @todo Move plant canopy stuff into plant canopy code
307	!------------------------------------------------------------------------------!
308	MODULE urban_surface_mod
309
310	#if ! defined( __nopointer )
311	USE arrays_3d, &
312	ONLY: dzu, hyp, zu, pt, pt_1, pt_2, p, u, v, w, hyp, tend
313	#endif
314
315	USE cloud_parameters, &
316	ONLY: cp, r_d
317
318	USE constants, &
319	ONLY: pi
320
321	USE control_parameters, &
322	ONLY: coupling_start_time, topography, dt_3d, humidity, &
323	intermediate_timestep_count, initializing_actions, &
324	intermediate_timestep_count_max, simulated_time, end_time, &
325	timestep_scheme, tsc, coupling_char, io_blocks, io_group, &
326	message_string, time_since_reference_point, surface_pressure, &
327	g, pt_surface, large_scale_forcing, lsf_surf, spinup, &
328	spinup_pt_mean, spinup_time, time_do3d, dt_do3d, &
329	average_count_3d, varnamelength, urban_surface, kappa, &
330	plant_canopy
331
332	USE cpulog, &
333	ONLY: cpu_log, log_point, log_point_s
334
335	USE date_and_time_mod, &
336	ONLY: time_utc_init
337
338	USE grid_variables, &
339	ONLY: dx, dy, ddx, ddy, ddx2, ddy2
340
341	USE indices, &
342	ONLY: nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, &
343	nysg, nzb, nzt, nbgp, wall_flags_0
344
345	USE, INTRINSIC :: iso_c_binding
346
347	USE kinds
348
349	USE pegrid
350
351	USE plant_canopy_model_mod, &
352	ONLY: pc_heating_rate, pc_transpiration_rate
353
354	USE radiation_model_mod, &
355	ONLY: albedo_type, radiation_interaction, calc_zenith, zenith, &
356	radiation, rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out, &
357	sigma_sb, solar_constant, sun_direction, sun_dir_lat, &
358	sun_dir_lon, &
359	force_radiation_call, surfinsw, surfinlw, surfinswdir, &
360	surfinswdif, surfoutsw, surfoutlw, surfins,nsvfl, svf, svfsurf, &
361	surfinl, surfinlwdif, rad_sw_in_dir, rad_sw_in_diff, &
362	rad_lw_in_diff, surfouts, surfoutl, surfoutsl, surfoutll, surf, &
363	surfl, nsurfl, nsurfs, surfstart, pcbinsw, pcbinlw, &
364	iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l, &
365	inorth_l, isouth_l, ieast_l, iwest_l, id, &
366	iz, iy, ix, idir, jdir, kdir, nsurf_type, nsurf, idsvf, ndsvf, &
367	iup_a, idown_a, inorth_a, isouth_a, ieast_a, iwest_a, &
368	idcsf, ndcsf, kdcsf, pct, &
369	startland, endland, startwall, endwall, skyvf, skyvft
370
371	USE statistics, &
372	ONLY: hom, statistic_regions
373
374	USE surface_mod, &
375	ONLY: get_topography_top_index_ji, get_topography_top_index, &
376	ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h, &
377	surf_usm_v, surface_restore_elements
378
379
380	IMPLICIT NONE
381
382
383	!-- configuration parameters (they can be setup in PALM config)
384	LOGICAL :: usm_material_model = .TRUE. !< flag parameter indicating wheather the model of heat in materials is used
385	LOGICAL :: usm_anthropogenic_heat = .FALSE. !< flag parameter indicating wheather the anthropogenic heat sources (e.g.transportation) are used
386	LOGICAL :: force_radiation_call_l = .FALSE. !< flag parameter for unscheduled radiation model calls
387	LOGICAL :: indoor_model = .FALSE. !< whether to use the indoor model
388	LOGICAL :: read_wall_temp_3d = .FALSE.
389
390
391	INTEGER(iwp) :: building_type = 1 !< default building type (preleminary setting)
392	INTEGER(iwp) :: land_category = 2 !< default category for land surface
393	INTEGER(iwp) :: wall_category = 2 !< default category for wall surface over pedestrian zone
394	INTEGER(iwp) :: pedestrian_category = 2 !< default category for wall surface in pedestrian zone
395	INTEGER(iwp) :: roof_category = 2 !< default category for root surface
396	REAL(wp) :: roughness_concrete = 0.001_wp !< roughness length of average concrete surface
397	!
398	!-- Indices of input attributes for (above) ground floor level
399	INTEGER(iwp) :: ind_alb_wall = 38 !< index in input list for albedo_type of wall fraction
400	INTEGER(iwp) :: ind_alb_green = 39 !< index in input list for albedo_type of green fraction
401	INTEGER(iwp) :: ind_alb_win = 40 !< index in input list for albedo_type of window fraction
402	INTEGER(iwp) :: ind_emis_wall_agfl = 14 !< index in input list for wall emissivity, above ground floor level
403	INTEGER(iwp) :: ind_emis_wall_gfl = 32 !< index in input list for wall emissivity, ground floor level
404	INTEGER(iwp) :: ind_emis_green_agfl = 15 !< index in input list for green emissivity, above ground floor level
405	INTEGER(iwp) :: ind_emis_green_gfl = 33 !< index in input list for green emissivity, ground floor level
406	INTEGER(iwp) :: ind_emis_win_agfl = 16 !< index in input list for window emissivity, above ground floor level
407	INTEGER(iwp) :: ind_emis_win_gfl = 34 !< index in input list for window emissivity, ground floor level
408	INTEGER(iwp) :: ind_green_frac_w_agfl = 2 !< index in input list for green fraction on wall, above ground floor level
409	INTEGER(iwp) :: ind_green_frac_w_gfl = 23 !< index in input list for green fraction on wall, ground floor level
410	INTEGER(iwp) :: ind_green_frac_r_agfl = 3 !< index in input list for green fraction on roof, above ground floor level
411	INTEGER(iwp) :: ind_green_frac_r_gfl = 24 !< index in input list for green fraction on roof, ground floor level
412	INTEGER(iwp) :: ind_hc1_agfl = 6 !< index in input list for heat capacity at first wall layer, above ground floor level
413	INTEGER(iwp) :: ind_hc1_gfl = 26 !< index in input list for heat capacity at first wall layer, ground floor level
414	INTEGER(iwp) :: ind_hc2_agfl = 7 !< index in input list for heat capacity at second wall layer, above ground floor level
415	INTEGER(iwp) :: ind_hc2_gfl = 27 !< index in input list for heat capacity at second wall layer, ground floor level
416	INTEGER(iwp) :: ind_hc3_agfl = 8 !< index in input list for heat capacity at third wall layer, above ground floor level
417	INTEGER(iwp) :: ind_hc3_gfl = 28 !< index in input list for heat capacity at third wall layer, ground floor level
418	INTEGER(iwp) :: ind_gflh = 20 !< index in input list for ground floor level height
419	INTEGER(iwp) :: ind_lai_r_agfl = 4 !< index in input list for LAI on roof, above ground floor level
420	INTEGER(iwp) :: ind_lai_r_gfl = 4 !< index in input list for LAI on roof, ground floor level
421	INTEGER(iwp) :: ind_lai_w_agfl = 5 !< index in input list for LAI on wall, above ground floor level
422	INTEGER(iwp) :: ind_lai_w_gfl = 25 !< index in input list for LAI on wall, ground floor level
423	INTEGER(iwp) :: ind_tc1_agfl = 9 !< index in input list for thermal conductivity at first wall layer, above ground floor level
424	INTEGER(iwp) :: ind_tc1_gfl = 29 !< index in input list for thermal conductivity at first wall layer, ground floor level
425	INTEGER(iwp) :: ind_tc2_agfl = 10 !< index in input list for thermal conductivity at second wall layer, above ground floor level
426	INTEGER(iwp) :: ind_tc2_gfl = 30 !< index in input list for thermal conductivity at second wall layer, ground floor level
427	INTEGER(iwp) :: ind_tc3_agfl = 11 !< index in input list for thermal conductivity at third wall layer, above ground floor level
428	INTEGER(iwp) :: ind_tc3_gfl = 31 !< index in input list for thermal conductivity at third wall layer, ground floor level
429	INTEGER(iwp) :: ind_thick_1 = 41 !< index for wall layer thickness - 1st layer
430	INTEGER(iwp) :: ind_thick_2 = 42 !< index for wall layer thickness - 2nd layer
431	INTEGER(iwp) :: ind_thick_3 = 43 !< index for wall layer thickness - 3rd layer
432	INTEGER(iwp) :: ind_thick_4 = 44 !< index for wall layer thickness - 4th layer
433	INTEGER(iwp) :: ind_trans_agfl = 17 !< index in input list for window transmissivity, above ground floor level
434	INTEGER(iwp) :: ind_trans_gfl = 35 !< index in input list for window transmissivity, ground floor level
435	INTEGER(iwp) :: ind_wall_frac_agfl = 0 !< index in input list for wall fraction, above ground floor level
436	INTEGER(iwp) :: ind_wall_frac_gfl = 21 !< index in input list for wall fraction, ground floor level
437	INTEGER(iwp) :: ind_win_frac_agfl = 1 !< index in input list for window fraction, above ground floor level
438	INTEGER(iwp) :: ind_win_frac_gfl = 22 !< index in input list for window fraction, ground floor level
439	INTEGER(iwp) :: ind_z0_agfl = 18 !< index in input list for z0, above ground floor level
440	INTEGER(iwp) :: ind_z0_gfl = 36 !< index in input list for z0, ground floor level
441	INTEGER(iwp) :: ind_z0qh_agfl = 19 !< index in input list for z0h / z0q, above ground floor level
442	INTEGER(iwp) :: ind_z0qh_gfl = 37 !< index in input list for z0h / z0q, ground floor level
443
444
445	REAL(wp) :: roof_height_limit = 4._wp !< height for distinguish between land surfaces and roofs
446	REAL(wp) :: ground_floor_level = 4.0_wp !< default ground floor level
447
448
449	CHARACTER(37), DIMENSION(0:7), PARAMETER :: building_type_name = (/ &
450	'user-defined ', & ! 0
451	'residential - 1950 ', & ! 1
452	'residential 1951 - 2000 ', & ! 2
453	'residential 2001 - ', & ! 3
454	'office - 1950 ', & ! 4
455	'office 1951 - 2000 ', & ! 5
456	'office 2001 - ', & ! 6
457	'bridges ' & ! 7
458	/)
459	!
460	!-- building parameters, 4 different types
461	!-- 0 - wall fraction, 1- window fraction, 2 - green fraction on wall, 3- green fraction
462	!-- at roof, 4 - lai of green fraction at roof, 5 - lai of green fraction at wall,
463	!-- 6 - heat capacity of wall layer 1, 7 - heat capacity of wall layer 2,
464	!-- 8 - heat capacity of wall layer 3, 9 - thermal conductivity of wall layer 1,
465	!-- 10 - thermal conductivity of wall layer 2, 11 - thermal conductivity of wall layer 3,
466	!-- 12 - indoor target summer temperature ( K ), 13 - indoor target winter temperature (K),
467	!-- 14 - emissivity of wall fraction, 15 - emissivity of green fraction, 16 - emissivity of window fraction,
468	!-- 17 - transmissivity of window fraction, 18 - z0, 19 - z0h/z0q, 20 - ground floor height,
469	!-- 21 - ground floor wall fraction, 22 - ground floor window fraction, 23 ground floor green fraction,
470	!-- 24 - ground floor green fraction on roof, 25 - ground floor lai of green fraction,
471	!-- 26 - ground floor heat capacity of wall layer 1, 27 - ground floor heat capacity of wall layer 1,
472	!-- 28 - ground floor heat capacity of wall layer 3, 29 - ground floor thermal conductivity of wall layer 1,
473	!-- 30 - ground floor thermal conductivity of wall layer 2, 31 - ground floor thermal conductivity of wall layer 3,
474	!-- 32 - ground floor emissivity of wall fraction, 33 - ground floor emissivity of green fraction,
475	!-- 34 - ground floor emissivity of window fraction, 35 - ground floor transmissivity of window fraction,
476	!-- 36 - ground floor z0, 37 - ground floor z0h/z0q, 38 - albedo type wall fraction
477	!-- 39 - albedo type green fraction, 40 - albedo type window fraction
478	!-- 41 - wall layer thickness - 1st layer, 42 - wall layer thickness - 2nd layer,
479	!-- 43 - wall layer thickness - 3rd layer, 44 - wall layer thickness - 4th layer,
480	!-- 45 - heat capacity of the wall surface, 46 - heat conductivity
481	!-- Please note, only preleminary dummy values so far!
482	REAL(wp), DIMENSION(0:46,1:7), PARAMETER :: building_pars = RESHAPE( (/ &
483	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
484	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
485	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
486	0.001_wp, 0.0001_wp, 4.0_wp, & !parameter 18-20
487	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
488	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
489	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
490	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
491	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
492	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
493	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 1
494	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
495	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
496	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
497	0.001_wp, 0.0001_wp, 4.0_wp, & !parameter 18-20
498	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
499	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
500	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
501	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
502	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
503	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
504	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 2
505	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
506	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
507	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
508	0.001_wp, 0.0001_wp, 4.0_wp, & !parameter 18-20
509	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
510	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
511	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
512	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
513	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
514	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
515	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 3
516	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
517	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
518	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
519	0.01_wp, 0.001_wp, 4.0_wp, & !parameter 18-20
520	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
521	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
522	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
523	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
524	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
525	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
526	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 4
527	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
528	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
529	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
530	0.001_wp, 0.0001_wp, 4.0_wp, & !parameter 18-20
531	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
532	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
533	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
534	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
535	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
536	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
537	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 5
538	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
539	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
540	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
541	0.001_wp, 0.0001_wp, 4.0_wp, & !parameter 18-20
542	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
543	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
544	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
545	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
546	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
547	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
548	20000.0_wp, 10.0_wp, & !parameter 45-46 - end of type 6
549	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp, & !parameter 0-5
550	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp, & !parameter 6-11
551	296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp, & !parameter 12-17
552	0.001_wp, 0.0001_wp, 0.0_wp, & !parameter 18-20
553	1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp, & !parameter 21-25
554	1000000.0_wp, 1000000.0_wp, 1000000.0_wp, & !parameter 26-28
555	0.3_wp, 0.3_wp, 0.3_wp, & !parameter 29-31
556	0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp, & !parameter 32-37
557	24.0_wp, 24.0_wp, 24.0_wp, & !parameter 38-40
558	0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp, & !parameter 41-44
559	20000.0_wp, 10.0_wp & !parameter 45-46 - end of type 7 (bridges)
560	/), &
561	(/47, 7/) )
562
563	!
564	!-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls.
565	TYPE t_surf_vertical
566	REAL(wp), DIMENSION(:), ALLOCATABLE :: t
567	END TYPE t_surf_vertical
568	!
569	!-- Type for wall temperatures at vertical walls. Is not necessary for horizontal walls.
570	TYPE t_wall_vertical
571	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t
572	END TYPE t_wall_vertical
573
574
575	!-- arrays for time averages
576	!-- Attention: the variable rad_net_av is also used in the 3d field variable in radiation_model_mod.f90. It may be better to rename it
577	REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_av !< average of rad_net_l
578	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw_av !< average of sw radiation falling to local surface including radiation from reflections
579	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw_av !< average of lw radiation falling to local surface including radiation from reflections
580	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdir_av !< average of direct sw radiation falling to local surface
581	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdif_av !< average of diffuse sw radiation from sky and model boundary falling to local surface
582	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwdif_av !< average of diffuse lw radiation from sky and model boundary falling to local surface
583	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswref_av !< average of sw radiation falling to surface from reflections
584	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwref_av !< average of lw radiation falling to surface from reflections
585	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw_av !< average of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
586	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw_av !< average of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
587	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in surface after last reflection
588	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in surface after last reflection
589	REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing from local surface
590	REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_av !< average of wghf_eb
591	REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb_av !< average of wshf_eb
592	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_wall_av !< Average of t_wall
593	REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green_av !< average of wghf_eb_green
594	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_green_av !< Average of t_green
595	REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window_av !< average of wghf_eb_window
596	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window
597
598
599	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
600	!-- anthropogenic heat sources
601	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
602	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: aheat !< daily average of anthropogenic heat (W/m2)
603	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aheatprof !< diurnal profiles of anthropogenic heat for particular layers
604	INTEGER(iwp) :: naheatlayers = 1 !< number of layers of anthropogenic heat
605
606	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
607	!-- wall surface model
608	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
609	!-- wall surface model constants
610	INTEGER(iwp), PARAMETER :: nzb_wall = 0 !< inner side of the wall model (to be switched)
611	INTEGER(iwp), PARAMETER :: nzt_wall = 3 !< outer side of the wall model (to be switched)
612	INTEGER(iwp), PARAMETER :: nzw = 4 !< number of wall layers (fixed for now)
613
614	REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
615	!< normalized soil, wall and roof layer depths (m/m)
616	! REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default = (/0.33_wp, 0.66_wp, 1.0_wp /)
617	REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_window = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
618	! REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_window = (/0.33_wp, 0.66_wp, 1.0_wp /)
619	! REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_window = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
620	!< normalized window layer depths (m/m)
621	! REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_green = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
622	!< normalized green layer depths (m/m)
623	REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_green = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
624	! REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: zwn_default_green = (/0.33_wp, 0.66_wp, 1.0_wp /)
625
626
627	REAL(wp) :: wall_inner_temperature = 295.0_wp !< temperature of the inner wall surface (~22 degrees C) (K)
628	REAL(wp) :: roof_inner_temperature = 295.0_wp !< temperature of the inner roof surface (~22 degrees C) (K)
629	REAL(wp) :: soil_inner_temperature = 288.0_wp !< temperature of the deep soil (~15 degrees C) (K)
630	REAL(wp) :: window_inner_temperature = 295.0_wp !< temperature of the inner window surface (~22 degrees C) (K)
631
632	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
633	!-- surface and material model variables for walls, ground, roofs
634	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
635	REAL(wp), DIMENSION(:), ALLOCATABLE :: zwn !< normalized wall layer depths (m)
636	REAL(wp), DIMENSION(:), ALLOCATABLE :: zwn_window !< normalized window layer depths (m)
637	REAL(wp), DIMENSION(:), ALLOCATABLE :: zwn_green !< normalized green layer depths (m)
638
639	#if defined( __nopointer )
640	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_h !< wall surface temperature (K) at horizontal walls
641	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_h_p !< progn. wall surface temperature (K) at horizontal walls
642	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_h !< window surface temperature (K) at horizontal walls
643	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_h_p !< progn. window surface temperature (K) at horizontal walls
644	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h !< green surface temperature (K) at horizontal walls
645	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_p !< progn. green surface temperature (K) at horizontal walls
646	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h !< near surface temperature (10cm) (K) at horizontal walls
647	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_p !< progn. near surface temperature (10cm) (K) at horizontal walls
648	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_v
649	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_v_p
650	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_window_v
651	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_window_v_p
652	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v
653	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_p
654	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v
655	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_p
656	#else
657	REAL(wp), DIMENSION(:), POINTER :: t_surf_h
658	REAL(wp), DIMENSION(:), POINTER :: t_surf_h_p
659	REAL(wp), DIMENSION(:), POINTER :: t_surf_window_h
660	REAL(wp), DIMENSION(:), POINTER :: t_surf_window_h_p
661	REAL(wp), DIMENSION(:), POINTER :: t_surf_green_h
662	REAL(wp), DIMENSION(:), POINTER :: t_surf_green_h_p
663	REAL(wp), DIMENSION(:), POINTER :: t_surf_10cm_h
664	REAL(wp), DIMENSION(:), POINTER :: t_surf_10cm_h_p
665
666	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_h_1
667	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_h_2
668	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_h_1
669	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_h_2
670	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_1
671	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_2
672	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_1
673	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_2
674
675	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_v
676	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_v_p
677	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_window_v
678	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_window_v_p
679	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_green_v
680	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_green_v_p
681	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_10cm_v
682	TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_10cm_v_p
683
684	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_v_1
685	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_v_2
686	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_window_v_1
687	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_window_v_2
688	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_1
689	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_2
690	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_1
691	TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_2
692
693	#endif
694	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_av !< average of wall surface temperature (K)
695	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_av !< average of window surface temperature (K)
696	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_av !< average of green wall surface temperature (K)
697	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_av !< average of whole wall surface temperature (K)
698
699	!-- Temporal tendencies for time stepping
700	REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_m !< surface temperature tendency of wall (K)
701	REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_window_m !< surface temperature tendency of window (K)
702	REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_green_m !< surface temperature tendency of green wall (K)
703
704	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
705	!-- Energy balance variables
706	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
707	!-- parameters of the land, roof and wall surfaces
708
709	#if defined( __nopointer )
710	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h !< Wall temperature (K)
711	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h_av !< Average of t_wall
712	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h_p !< Prog. wall temperature (K)
713	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_window_h !< Window temperature (K)
714	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_window_h_av !< Average of t_window
715	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_window_h_p !< Prog. window temperature (K)
716	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_green_h !< Green temperature (K)
717	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_green_h_av !< Average of t_green
718	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_green_h_p !< Prog. green temperature (K)
719
720	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_wall_v !< Wall temperature (K)
721	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_wall_v_av !< Average of t_wall
722	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_wall_v_p !< Prog. wall temperature (K)
723	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_window_v !< Window temperature (K)
724	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_window_v_av !< Average of t_window
725	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_window_v_p !< Prog. window temperature (K)
726	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_green_v !< Green temperature (K)
727	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_green_v_av !< Average of t_green
728	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_green_v_p !< Prog. green temperature (K)
729	#else
730	REAL(wp), DIMENSION(:,:), POINTER :: t_wall_h, t_wall_h_p
731	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h_av, t_wall_h_1, t_wall_h_2
732	REAL(wp), DIMENSION(:,:), POINTER :: t_window_h, t_window_h_p
733	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_window_h_av, t_window_h_1, t_window_h_2
734	REAL(wp), DIMENSION(:,:), POINTER :: t_green_h, t_green_h_p
735	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_green_h_av, t_green_h_1, t_green_h_2
736
737	TYPE(t_wall_vertical), DIMENSION(:), POINTER :: t_wall_v, t_wall_v_p
738	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_wall_v_av, t_wall_v_1, t_wall_v_2
739	TYPE(t_wall_vertical), DIMENSION(:), POINTER :: t_window_v, t_window_v_p
740	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_window_v_av, t_window_v_1, t_window_v_2
741	TYPE(t_wall_vertical), DIMENSION(:), POINTER :: t_green_v, t_green_v_p
742	TYPE(t_wall_vertical), DIMENSION(0:3), TARGET :: t_green_v_av, t_green_v_1, t_green_v_2
743	#endif
744
745	!-- Wall temporal tendencies for time stepping
746	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array
747	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array
748	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array
749
750	!-- Surface and material parameters classes (surface_type)
751	!-- albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
752	INTEGER(iwp) :: n_surface_types !< number of the wall type categories
753	INTEGER(iwp), PARAMETER :: n_surface_params = 9 !< number of parameters for each type of the wall
754	INTEGER(iwp), PARAMETER :: ialbedo = 1 !< albedo of the surface
755	INTEGER(iwp), PARAMETER :: iemiss = 2 !< emissivity of the surface
756	INTEGER(iwp), PARAMETER :: ilambdas = 3 !< heat conductivity lambda S between surface and material ( W m-2 K-1 )
757	INTEGER(iwp), PARAMETER :: irough = 4 !< roughness length z0 for movements
758	INTEGER(iwp), PARAMETER :: iroughh = 5 !< roughness length z0h for scalars (heat, humidity,...)
759	INTEGER(iwp), PARAMETER :: icsurf = 6 !< Surface skin layer heat capacity (J m-2 K-1 )
760	INTEGER(iwp), PARAMETER :: ithick = 7 !< thickness of the surface (wall, roof, land) ( m )
761	INTEGER(iwp), PARAMETER :: irhoC = 8 !< volumetric heat capacity rho*C of the material ( J m-3 K-1 )
762	INTEGER(iwp), PARAMETER :: ilambdah = 9 !< thermal conductivity lambda H of the wall (W m-1 K-1 )
763	CHARACTER(12), DIMENSION(:), ALLOCATABLE :: surface_type_names !< names of wall types (used only for reports)
764	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: surface_type_codes !< codes of wall types
765	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: surface_params !< parameters of wall types
766
767
768	!-- interfaces of subroutines accessed from outside of this module
769	INTERFACE usm_boundary_condition
770	MODULE PROCEDURE usm_boundary_condition
771	END INTERFACE usm_boundary_condition
772
773	INTERFACE usm_check_data_output
774	MODULE PROCEDURE usm_check_data_output
775	END INTERFACE usm_check_data_output
776
777	INTERFACE usm_check_parameters
778	MODULE PROCEDURE usm_check_parameters
779	END INTERFACE usm_check_parameters
780
781	INTERFACE usm_data_output_3d
782	MODULE PROCEDURE usm_data_output_3d
783	END INTERFACE usm_data_output_3d
784
785	INTERFACE usm_define_netcdf_grid
786	MODULE PROCEDURE usm_define_netcdf_grid
787	END INTERFACE usm_define_netcdf_grid
788
789	INTERFACE usm_init_urban_surface
790	MODULE PROCEDURE usm_init_urban_surface
791	END INTERFACE usm_init_urban_surface
792
793	INTERFACE usm_material_heat_model
794	MODULE PROCEDURE usm_material_heat_model
795	END INTERFACE usm_material_heat_model
796
797	INTERFACE usm_green_heat_model
798	MODULE PROCEDURE usm_green_heat_model
799	END INTERFACE usm_green_heat_model
800
801	INTERFACE usm_parin
802	MODULE PROCEDURE usm_parin
803	END INTERFACE usm_parin
804
805	INTERFACE usm_temperature_near_surface
806	MODULE PROCEDURE usm_temperature_near_surface
807	END INTERFACE usm_temperature_near_surface
808
809	INTERFACE usm_rrd_local
810	MODULE PROCEDURE usm_rrd_local
811	END INTERFACE usm_rrd_local
812
813	INTERFACE usm_surface_energy_balance
814	MODULE PROCEDURE usm_surface_energy_balance
815	END INTERFACE usm_surface_energy_balance
816
817	INTERFACE usm_swap_timelevel
818	MODULE PROCEDURE usm_swap_timelevel
819	END INTERFACE usm_swap_timelevel
820
821	INTERFACE usm_wrd_local
822	MODULE PROCEDURE usm_wrd_local
823	END INTERFACE usm_wrd_local
824
825	INTERFACE usm_allocate_surface
826	MODULE PROCEDURE usm_allocate_surface
827	END INTERFACE usm_allocate_surface
828
829	INTERFACE usm_average_3d_data
830	MODULE PROCEDURE usm_average_3d_data
831	END INTERFACE usm_average_3d_data
832
833
834	SAVE
835
836	PRIVATE
837
838	!-- Public functions
839	PUBLIC usm_boundary_condition, usm_check_parameters, usm_init_urban_surface,&
840	usm_rrd_local, &
841	usm_surface_energy_balance, usm_material_heat_model, &
842	usm_swap_timelevel, usm_check_data_output, usm_average_3d_data, &
843	usm_data_output_3d, usm_define_netcdf_grid, usm_parin, &
844	usm_wrd_local, usm_allocate_surface
845
846	!-- Public parameters, constants and initial values
847	PUBLIC usm_anthropogenic_heat, usm_material_model, &
848	usm_green_heat_model, usm_temperature_near_surface
849
850
851
852	CONTAINS
853
854	!------------------------------------------------------------------------------!
855	! Description:
856	! ------------
857	!> This subroutine creates the necessary indices of the urban surfaces
858	!> and plant canopy and it allocates the needed arrays for USM
859	!------------------------------------------------------------------------------!
860	SUBROUTINE usm_allocate_surface
861
862	IMPLICIT NONE
863
864	INTEGER(iwp) :: l
865
866	!
867	!-- Allocate radiation arrays which are part of the new data type.
868	!-- For horizontal surfaces.
869	ALLOCATE( surf_usm_h%surfhf(1:surf_usm_h%ns) )
870	ALLOCATE( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
871	!
872	!-- For vertical surfaces
873	DO l = 0, 3
874	ALLOCATE( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns) )
875	ALLOCATE( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
876	ENDDO
877
878	!-- Wall surface model
879	!-- allocate arrays for wall surface model and define pointers
880
881	!-- allocate array of wall types and wall parameters
882	ALLOCATE ( surf_usm_h%surface_types(1:surf_usm_h%ns) )
883	DO l = 0, 3
884	ALLOCATE( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns) )
885	ENDDO
886	!
887	!-- Allocate albedo_type and albedo. Each surface element
888	!-- has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction.
889	ALLOCATE( surf_usm_h%albedo_type(0:2,1:surf_usm_h%ns) )
890	ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns) )
891	surf_usm_h%albedo_type = albedo_type
892	DO l = 0, 3
893	ALLOCATE( surf_usm_v(l)%albedo_type(0:2,1:surf_usm_v(l)%ns) )
894	ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns) )
895	surf_usm_v(l)%albedo_type = albedo_type
896	ENDDO
897
898
899	!
900	!-- Allocate indoor target temperature for summer and winter
901	ALLOCATE( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
902	ALLOCATE( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
903	DO l = 0, 3
904	ALLOCATE( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
905	ALLOCATE( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
906	ENDDO
907	!
908	!-- Allocate flag indicating ground floor level surface elements
909	ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) )
910	DO l = 0, 3
911	ALLOCATE( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
912	ENDDO
913	!
914	!-- Allocate arrays for relative surface fraction.
915	!-- 0 - wall fraction, 1 - green fraction, 2 - window fraction
916	ALLOCATE( surf_usm_h%frac(0:2,1:surf_usm_h%ns) )
917	surf_usm_h%frac = 0.0_wp
918	DO l = 0, 3
919	ALLOCATE( surf_usm_v(l)%frac(0:2,1:surf_usm_v(l)%ns) )
920	surf_usm_v(l)%frac = 0.0_wp
921	ENDDO
922
923	!-- wall and roof surface parameters. First for horizontal surfaces
924	ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns) )
925	ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns) )
926	ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
927	ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns) )
928	ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns) )
929	ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns) )
930	ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns) )
931	ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns) )
932	ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns) )
933	ALLOCATE ( surf_usm_h%emissivity(0:2,1:surf_usm_h%ns) )
934	ALLOCATE ( surf_usm_h%r_a(1:surf_usm_h%ns) )
935	ALLOCATE ( surf_usm_h%r_a_green(1:surf_usm_h%ns) )
936	ALLOCATE ( surf_usm_h%r_a_window(1:surf_usm_h%ns) )
937
938	!
939	!-- For vertical surfaces.
940	DO l = 0, 3
941	ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns) )
942	ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns) )
943	ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
944	ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns) )
945	ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns) )
946	ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns) )
947	ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns) )
948	ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns) )
949	ALLOCATE ( surf_usm_v(l)%emissivity(0:2,1:surf_usm_v(l)%ns) )
950	ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns) )
951	ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns) )
952	ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns) )
953	ENDDO
954
955	!
956	!-- allocate wall and roof material parameters. First for horizontal surfaces
957	ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns) )
958	ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns) )
959	ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns) )
960	ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
961	ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
962	ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
963	ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
964	ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
965	ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
966
967	!
968	!-- For vertical surfaces.
969	DO l = 0, 3
970	ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns) )
971	ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns) )
972	ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns) )
973	ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
974	ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
975	ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
976	ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
977	ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
978	ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
979	ENDDO
980
981	!-- allocate wall and roof layers sizes. For horizontal surfaces.
982	ALLOCATE ( zwn(nzb_wall:nzt_wall) )
983	ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
984	ALLOCATE ( zwn_window(nzb_wall:nzt_wall) )
985	ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
986	ALLOCATE ( zwn_green(nzb_wall:nzt_wall) )
987	ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
988	ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
989	ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
990	ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
991	ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
992	ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
993	ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
994	ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
995	ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
996	ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
997	ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
998	ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
999	ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1000	!
1001	!-- For vertical surfaces.
1002	DO l = 0, 3
1003	ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1004	ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1005	ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1006	ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1007	ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1008	ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1009	ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1010	ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1011	ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1012	ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1013	ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1014	ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1015	ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1016	ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1017	ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1018	ENDDO
1019
1020	!-- allocate wall and roof temperature arrays, for horizontal walls
1021	#if defined( __nopointer )
1022	IF ( .NOT. ALLOCATED( t_surf_h ) ) &
1023	ALLOCATE ( t_surf_h(1:surf_usm_h%ns) )
1024	IF ( .NOT. ALLOCATED( t_surf_h_p ) ) &
1025	ALLOCATE ( t_surf_h_p(1:surf_usm_h%ns) )
1026	IF ( .NOT. ALLOCATED( t_wall_h ) ) &
1027	ALLOCATE ( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1028	IF ( .NOT. ALLOCATED( t_wall_h_p ) ) &
1029	ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1030	IF ( .NOT. ALLOCATED( t_surf_window_h ) ) &
1031	ALLOCATE ( t_surf_window_h(1:surf_usm_h%ns) )
1032	IF ( .NOT. ALLOCATED( t_surf_window_h_p ) ) &
1033	ALLOCATE ( t_surf_window_h_p(1:surf_usm_h%ns) )
1034	IF ( .NOT. ALLOCATED( t_window_h ) ) &
1035	ALLOCATE ( t_window_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1036	IF ( .NOT. ALLOCATED( t_window_h_p ) ) &
1037	ALLOCATE ( t_window_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1038	IF ( .NOT. ALLOCATED( t_surf_green_h ) ) &
1039	ALLOCATE ( t_surf_green_h(1:surf_usm_h%ns) )
1040	IF ( .NOT. ALLOCATED( t_surf_green_h_p ) ) &
1041	ALLOCATE ( t_surf_green_h_p(1:surf_usm_h%ns) )
1042	IF ( .NOT. ALLOCATED( t_green_h ) ) &
1043	ALLOCATE ( t_green_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1044	IF ( .NOT. ALLOCATED( t_green_h_p ) ) &
1045	ALLOCATE ( t_green_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1046	IF ( .NOT. ALLOCATED( t_surf_10cm_h ) ) &
1047	ALLOCATE ( t_surf_10cm_h(1:surf_usm_h%ns) )
1048	IF ( .NOT. ALLOCATED( t_surf_10cm_h_p ) ) &
1049	ALLOCATE ( t_surf_10cm_h_p(1:surf_usm_h%ns) )
1050	#else
1051	!
1052	!-- Allocate if required. Note, in case of restarts, some of these arrays
1053	!-- might be already allocated.
1054	IF ( .NOT. ALLOCATED( t_surf_h_1 ) ) &
1055	ALLOCATE ( t_surf_h_1(1:surf_usm_h%ns) )
1056	IF ( .NOT. ALLOCATED( t_surf_h_2 ) ) &
1057	ALLOCATE ( t_surf_h_2(1:surf_usm_h%ns) )
1058	IF ( .NOT. ALLOCATED( t_wall_h_1 ) ) &
1059	ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1060	IF ( .NOT. ALLOCATED( t_wall_h_2 ) ) &
1061	ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1062	IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) ) &
1063	ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
1064	IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) ) &
1065	ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
1066	IF ( .NOT. ALLOCATED( t_window_h_1 ) ) &
1067	ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1068	IF ( .NOT. ALLOCATED( t_window_h_2 ) ) &
1069	ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1070	IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) ) &
1071	ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
1072	IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) ) &
1073	ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
1074	IF ( .NOT. ALLOCATED( t_green_h_1 ) ) &
1075	ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1076	IF ( .NOT. ALLOCATED( t_green_h_2 ) ) &
1077	ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1078	IF ( .NOT. ALLOCATED( t_surf_10cm_h_1 ) ) &
1079	ALLOCATE ( t_surf_10cm_h_1(1:surf_usm_h%ns) )
1080	IF ( .NOT. ALLOCATED( t_surf_10cm_h_2 ) ) &
1081	ALLOCATE ( t_surf_10cm_h_2(1:surf_usm_h%ns) )
1082	!
1083	!-- initial assignment of the pointers
1084	t_wall_h => t_wall_h_1; t_wall_h_p => t_wall_h_2
1085	t_window_h => t_window_h_1; t_window_h_p => t_window_h_2
1086	t_green_h => t_green_h_1; t_green_h_p => t_green_h_2
1087	t_surf_h => t_surf_h_1; t_surf_h_p => t_surf_h_2
1088	t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2
1089	t_surf_green_h => t_surf_green_h_1; t_surf_green_h_p => t_surf_green_h_2
1090	t_surf_10cm_h => t_surf_10cm_h_1; t_surf_10cm_h_p => t_surf_10cm_h_2
1091
1092	#endif
1093
1094	!-- allocate wall and roof temperature arrays, for vertical walls if required
1095	#if defined( __nopointer )
1096	DO l = 0, 3
1097	IF ( .NOT. ALLOCATED( t_surf_v(l)%t ) ) &
1098	ALLOCATE ( t_surf_v(l)%t(1:surf_usm_v(l)%ns) )
1099	IF ( .NOT. ALLOCATED( t_surf_v_p(l)%t ) ) &
1100	ALLOCATE ( t_surf_v_p(l)%t(1:surf_usm_v(l)%ns) )
1101	IF ( .NOT. ALLOCATED( t_wall_v(l)%t ) ) &
1102	ALLOCATE ( t_wall_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1103	IF ( .NOT. ALLOCATED( t_wall_v_p(l)%t ) ) &
1104	ALLOCATE ( t_wall_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1105	IF ( .NOT. ALLOCATED( t_surf_window_v(l)%t ) ) &
1106	ALLOCATE ( t_surf_window_v(l)%t(1:surf_usm_v(l)%ns) )
1107	IF ( .NOT. ALLOCATED( t_surf_window_v_p(l)%t ) ) &
1108	ALLOCATE ( t_surf_window_v_p(l)%t(1:surf_usm_v(l)%ns) )
1109	IF ( .NOT. ALLOCATED( t_window_v(l)%t ) ) &
1110	ALLOCATE ( t_window_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1111	IF ( .NOT. ALLOCATED( t_window_v_p(l)%t ) ) &
1112	ALLOCATE ( t_window_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1113	IF ( .NOT. ALLOCATED( t_green_v(l)%t ) ) &
1114	ALLOCATE ( t_green_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1115	IF ( .NOT. ALLOCATED( t_green_v_p(l)%t ) ) &
1116	ALLOCATE ( t_green_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1117	IF ( .NOT. ALLOCATED( t_surf_green_v(l)%t ) ) &
1118	ALLOCATE ( t_surf_green_v(l)%t(1:surf_usm_v(l)%ns) )
1119	IF ( .NOT. ALLOCATED( t_surf_green_v_p(l)%t ) ) &
1120	ALLOCATE ( t_surf_green_v_p(l)%t(1:surf_usm_v(l)%ns) )
1121	IF ( .NOT. ALLOCATED( t_surf_10cm_v(l)%t ) ) &
1122	ALLOCATE ( t_surf_10cm_v(l)%t(1:surf_usm_v(l)%ns) )
1123	IF ( .NOT. ALLOCATED( t_surf_10cm_v_p(l)%t ) ) &
1124	ALLOCATE ( t_surf_10cm_v_p(l)%t(1:surf_usm_v(l)%ns) )
1125	ENDDO
1126	#else
1127	!
1128	!-- Allocate if required. Note, in case of restarts, some of these arrays
1129	!-- might be already allocated.
1130	DO l = 0, 3
1131	IF ( .NOT. ALLOCATED( t_surf_v_1(l)%t ) ) &
1132	ALLOCATE ( t_surf_v_1(l)%t(1:surf_usm_v(l)%ns) )
1133	IF ( .NOT. ALLOCATED( t_surf_v_2(l)%t ) ) &
1134	ALLOCATE ( t_surf_v_2(l)%t(1:surf_usm_v(l)%ns) )
1135	IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) ) &
1136	ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1137	IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) ) &
1138	ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1139	IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) ) &
1140	ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
1141	IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) ) &
1142	ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
1143	IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) ) &
1144	ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1145	IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) ) &
1146	ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1147	IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) ) &
1148	ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
1149	IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) ) &
1150	ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
1151	IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) ) &
1152	ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1153	IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) ) &
1154	ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1155	IF ( .NOT. ALLOCATED( t_surf_10cm_v_1(l)%t ) ) &
1156	ALLOCATE ( t_surf_10cm_v_1(l)%t(1:surf_usm_v(l)%ns) )
1157	IF ( .NOT. ALLOCATED( t_surf_10cm_v_2(l)%t ) ) &
1158	ALLOCATE ( t_surf_10cm_v_2(l)%t(1:surf_usm_v(l)%ns) )
1159	ENDDO
1160	!
1161	!-- initial assignment of the pointers
1162	t_wall_v => t_wall_v_1; t_wall_v_p => t_wall_v_2
1163	t_surf_v => t_surf_v_1; t_surf_v_p => t_surf_v_2
1164	t_window_v => t_window_v_1; t_window_v_p => t_window_v_2
1165	t_green_v => t_green_v_1; t_green_v_p => t_green_v_2
1166	t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
1167	t_surf_green_v => t_surf_green_v_1; t_surf_green_v_p => t_surf_green_v_2
1168	t_surf_10cm_v => t_surf_10cm_v_1; t_surf_10cm_v_p => t_surf_10cm_v_2
1169
1170	#endif
1171	!
1172	!-- Allocate intermediate timestep arrays. For horizontal surfaces.
1173	ALLOCATE ( surf_usm_h%tt_surface_m(1:surf_usm_h%ns) )
1174	ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1175	ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns) )
1176	ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1177	ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
1178	ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns) )
1179
1180	!
1181	!-- Set inital values for prognostic quantities
1182	IF ( ALLOCATED( surf_usm_h%tt_surface_m ) ) surf_usm_h%tt_surface_m = 0.0_wp
1183	IF ( ALLOCATED( surf_usm_h%tt_wall_m ) ) surf_usm_h%tt_wall_m = 0.0_wp
1184	IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) ) surf_usm_h%tt_surface_window_m = 0.0_wp
1185	IF ( ALLOCATED( surf_usm_h%tt_window_m ) ) surf_usm_h%tt_window_m = 0.0_wp
1186	IF ( ALLOCATED( surf_usm_h%tt_green_m ) ) surf_usm_h%tt_green_m = 0.0_wp
1187	IF ( ALLOCATED( surf_usm_h%tt_surface_green_m ) ) surf_usm_h%tt_surface_green_m = 0.0_wp
1188	!
1189	!-- Now, for vertical surfaces
1190	DO l = 0, 3
1191	ALLOCATE ( surf_usm_v(l)%tt_surface_m(1:surf_usm_v(l)%ns) )
1192	ALLOCATE ( surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1193	IF ( ALLOCATED( surf_usm_v(l)%tt_surface_m ) ) surf_usm_v(l)%tt_surface_m = 0.0_wp
1194	IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m ) ) surf_usm_v(l)%tt_wall_m = 0.0_wp
1195	ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns) )
1196	ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1197	IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) ) surf_usm_v(l)%tt_surface_window_m = 0.0_wp
1198	IF ( ALLOCATED( surf_usm_v(l)%tt_window_m ) ) surf_usm_v(l)%tt_window_m = 0.0_wp
1199	ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns) )
1200	IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) ) surf_usm_v(l)%tt_surface_green_m = 0.0_wp
1201	ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
1202	IF ( ALLOCATED( surf_usm_v(l)%tt_green_m ) ) surf_usm_v(l)%tt_green_m = 0.0_wp
1203	ENDDO
1204
1205	!-- allocate wall heat flux output array and set initial values. For horizontal surfaces
1206	! ALLOCATE ( surf_usm_h%wshf(1:surf_usm_h%ns) ) !can be removed
1207	ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
1208	ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
1209	ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
1210	ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
1211	ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
1212	ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
1213	IF ( ALLOCATED( surf_usm_h%wshf ) ) surf_usm_h%wshf = 0.0_wp
1214	IF ( ALLOCATED( surf_usm_h%wshf_eb ) ) surf_usm_h%wshf_eb = 0.0_wp
1215	IF ( ALLOCATED( surf_usm_h%wghf_eb ) ) surf_usm_h%wghf_eb = 0.0_wp
1216	IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) ) surf_usm_h%wghf_eb_window = 0.0_wp
1217	IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) ) surf_usm_h%wghf_eb_green = 0.0_wp
1218	IF ( ALLOCATED( surf_usm_h%iwghf_eb ) ) surf_usm_h%iwghf_eb = 0.0_wp
1219	IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) ) surf_usm_h%iwghf_eb_window = 0.0_wp
1220	!
1221	!-- Now, for vertical surfaces
1222	DO l = 0, 3
1223	! ALLOCATE ( surf_usm_v(l)%wshf(1:surf_usm_v(l)%ns) ) ! can be removed
1224	ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
1225	ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
1226	ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
1227	ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
1228	ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
1229	ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
1230	IF ( ALLOCATED( surf_usm_v(l)%wshf ) ) surf_usm_v(l)%wshf = 0.0_wp
1231	IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) ) surf_usm_v(l)%wshf_eb = 0.0_wp
1232	IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) ) surf_usm_v(l)%wghf_eb = 0.0_wp
1233	IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) ) surf_usm_v(l)%wghf_eb_window = 0.0_wp
1234	IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) ) surf_usm_v(l)%wghf_eb_green = 0.0_wp
1235	IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) ) surf_usm_v(l)%iwghf_eb = 0.0_wp
1236	IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) ) surf_usm_v(l)%iwghf_eb_window = 0.0_wp
1237	ENDDO
1238
1239	END SUBROUTINE usm_allocate_surface
1240
1241
1242	!------------------------------------------------------------------------------!
1243	! Description:
1244	! ------------
1245	!> Sum up and time-average urban surface output quantities as well as allocate
1246	!> the array necessary for storing the average.
1247	!------------------------------------------------------------------------------!
1248	SUBROUTINE usm_average_3d_data( mode, variable )
1249
1250	IMPLICIT NONE
1251
1252	CHARACTER (len=*), INTENT(IN) :: mode
1253	CHARACTER (len=*), INTENT(IN) :: variable
1254
1255	INTEGER(iwp) :: i, j, k, l, m, ids, idsint, iwl, istat
1256	CHARACTER (len=varnamelength) :: var, surfid
1257	INTEGER(iwp), PARAMETER :: nd = 5
1258	CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
1259	INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
1260
1261	!-- find the real name of the variable
1262	ids = -1
1263	var = TRIM(variable)
1264	DO i = 0, nd-1
1265	k = len(TRIM(var))
1266	j = len(TRIM(dirname(i)))
1267	IF ( var(k-j+1:k) == dirname(i) ) THEN
1268	ids = i
1269	idsint = dirint(ids)
1270	var = var(:k-j)
1271	EXIT
1272	ENDIF
1273	ENDDO
1274	IF ( ids == -1 ) THEN
1275	var = TRIM(variable)
1276	ENDIF
1277	IF ( var(1:11) == 'usm_t_wall_' .AND. len(TRIM(var)) >= 12 ) THEN
1278	!-- wall layers
1279	READ(var(12:12), '(I1)', iostat=istat ) iwl
1280	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
1281	var = var(1:10)
1282	ELSE
1283	!-- wrong wall layer index
1284	RETURN
1285	ENDIF
1286	ENDIF
1287	IF ( var(1:13) == 'usm_t_window_' .AND. len(TRIM(var)) >= 14 ) THEN
1288	!-- wall layers
1289	READ(var(14:14), '(I1)', iostat=istat ) iwl
1290	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
1291	var = var(1:12)
1292	ELSE
1293	!-- wrong window layer index
1294	RETURN
1295	ENDIF
1296	ENDIF
1297	IF ( var(1:12) == 'usm_t_green_' .AND. len(TRIM(var)) >= 13 ) THEN
1298	!-- wall layers
1299	READ(var(13:13), '(I1)', iostat=istat ) iwl
1300	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
1301	var = var(1:11)
1302	ELSE
1303	!-- wrong green layer index
1304	RETURN
1305	ENDIF
1306	ENDIF
1307
1308	IF ( mode == 'allocate' ) THEN
1309
1310	SELECT CASE ( TRIM( var ) )
1311
1312	CASE ( 'usm_rad_net' )
1313	!-- array of complete radiation balance
1314	IF ( .NOT. ALLOCATED(surf_usm_h%rad_net_av) ) THEN
1315	ALLOCATE( surf_usm_h%rad_net_av(1:surf_usm_h%ns) )
1316	surf_usm_h%rad_net_av = 0.0_wp
1317	ENDIF
1318	DO l = 0, 3
1319	IF ( .NOT. ALLOCATED(surf_usm_v(l)%rad_net_av) ) THEN
1320	ALLOCATE( surf_usm_v(l)%rad_net_av(1:surf_usm_v(l)%ns) )
1321	surf_usm_v(l)%rad_net_av = 0.0_wp
1322	ENDIF
1323	ENDDO
1324
1325	CASE ( 'usm_rad_insw' )
1326	!-- array of sw radiation falling to surface after i-th reflection
1327	IF ( .NOT. ALLOCATED(surfinsw_av) ) THEN
1328	ALLOCATE( surfinsw_av(nsurfl) )
1329	surfinsw_av = 0.0_wp
1330	ENDIF
1331
1332	CASE ( 'usm_rad_inlw' )
1333	!-- array of lw radiation falling to surface after i-th reflection
1334	IF ( .NOT. ALLOCATED(surfinlw_av) ) THEN
1335	ALLOCATE( surfinlw_av(nsurfl) )
1336	surfinlw_av = 0.0_wp
1337	ENDIF
1338
1339	CASE ( 'usm_rad_inswdir' )
1340	!-- array of direct sw radiation falling to surface from sun
1341	IF ( .NOT. ALLOCATED(surfinswdir_av) ) THEN
1342	ALLOCATE( surfinswdir_av(nsurfl) )
1343	surfinswdir_av = 0.0_wp
1344	ENDIF
1345
1346	CASE ( 'usm_rad_inswdif' )
1347	!-- array of difusion sw radiation falling to surface from sky and borders of the domain
1348	IF ( .NOT. ALLOCATED(surfinswdif_av) ) THEN
1349	ALLOCATE( surfinswdif_av(nsurfl) )
1350	surfinswdif_av = 0.0_wp
1351	ENDIF
1352
1353	CASE ( 'usm_rad_inswref' )
1354	!-- array of sw radiation falling to surface from reflections
1355	IF ( .NOT. ALLOCATED(surfinswref_av) ) THEN
1356	ALLOCATE( surfinswref_av(nsurfl) )
1357	surfinswref_av = 0.0_wp
1358	ENDIF
1359
1360	CASE ( 'usm_rad_inlwdif' )
1361	!-- array of sw radiation falling to surface after i-th reflection
1362	IF ( .NOT. ALLOCATED(surfinlwdif_av) ) THEN
1363	ALLOCATE( surfinlwdif_av(nsurfl) )
1364	surfinlwdif_av = 0.0_wp
1365	ENDIF
1366
1367	CASE ( 'usm_rad_inlwref' )
1368	!-- array of lw radiation falling to surface from reflections
1369	IF ( .NOT. ALLOCATED(surfinlwref_av) ) THEN
1370	ALLOCATE( surfinlwref_av(nsurfl) )
1371	surfinlwref_av = 0.0_wp
1372	ENDIF
1373
1374	CASE ( 'usm_rad_outsw' )
1375	!-- array of sw radiation emitted from surface after i-th reflection
1376	IF ( .NOT. ALLOCATED(surfoutsw_av) ) THEN
1377	ALLOCATE( surfoutsw_av(nsurfl) )
1378	surfoutsw_av = 0.0_wp
1379	ENDIF
1380
1381	CASE ( 'usm_rad_outlw' )
1382	!-- array of lw radiation emitted from surface after i-th reflection
1383	IF ( .NOT. ALLOCATED(surfoutlw_av) ) THEN
1384	ALLOCATE( surfoutlw_av(nsurfl) )
1385	surfoutlw_av = 0.0_wp
1386	ENDIF
1387	CASE ( 'usm_rad_ressw' )
1388	!-- array of residua of sw radiation absorbed in surface after last reflection
1389	IF ( .NOT. ALLOCATED(surfins_av) ) THEN
1390	ALLOCATE( surfins_av(nsurfl) )
1391	surfins_av = 0.0_wp
1392	ENDIF
1393
1394	CASE ( 'usm_rad_reslw' )
1395	!-- array of residua of lw radiation absorbed in surface after last reflection
1396	IF ( .NOT. ALLOCATED(surfinl_av) ) THEN
1397	ALLOCATE( surfinl_av(nsurfl) )
1398	surfinl_av = 0.0_wp
1399	ENDIF
1400
1401	CASE ( 'usm_rad_hf' )
1402	!-- array of heat flux from radiation for surfaces after i-th reflection
1403	IF ( .NOT. ALLOCATED(surf_usm_h%surfhf_av) ) THEN
1404	ALLOCATE( surf_usm_h%surfhf_av(1:surf_usm_h%ns) )
1405	surf_usm_h%surfhf_av = 0.0_wp
1406	ENDIF
1407	DO l = 0, 3
1408	IF ( .NOT. ALLOCATED(surf_usm_v(l)%surfhf_av) ) THEN
1409	ALLOCATE( surf_usm_v(l)%surfhf_av(1:surf_usm_v(l)%ns) )
1410	surf_usm_v(l)%surfhf_av = 0.0_wp
1411	ENDIF
1412	ENDDO
1413
1414	CASE ( 'usm_wshf' )
1415	!-- array of sensible heat flux from surfaces
1416	!-- land surfaces
1417	IF ( .NOT. ALLOCATED(surf_usm_h%wshf_eb_av) ) THEN
1418	ALLOCATE( surf_usm_h%wshf_eb_av(1:surf_usm_h%ns) )
1419	surf_usm_h%wshf_eb_av = 0.0_wp
1420	ENDIF
1421	DO l = 0, 3
1422	IF ( .NOT. ALLOCATED(surf_usm_v(l)%wshf_eb_av) ) THEN
1423	ALLOCATE( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) )
1424	surf_usm_v(l)%wshf_eb_av = 0.0_wp
1425	ENDIF
1426	ENDDO
1427	!
1428	!-- Please note, the following output quantities belongs to the
1429	!-- individual tile fractions - ground heat flux at wall-, window-,
1430	!-- and green fraction. Aggregated ground-heat flux is treated
1431	!-- accordingly in average_3d_data, sum_up_3d_data, etc..
1432	CASE ( 'usm_wghf' )
1433	!-- array of heat flux from ground (wall, roof, land)
1434	IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_av) ) THEN
1435	ALLOCATE( surf_usm_h%wghf_eb_av(1:surf_usm_h%ns) )
1436	surf_usm_h%wghf_eb_av = 0.0_wp
1437	ENDIF
1438	DO l = 0, 3
1439	IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_av) ) THEN
1440	ALLOCATE( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) )
1441	surf_usm_v(l)%wghf_eb_av = 0.0_wp
1442	ENDIF
1443	ENDDO
1444
1445	CASE ( 'usm_wghf_window' )
1446	!-- array of heat flux from window ground (wall, roof, land)
1447	IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_window_av) ) THEN
1448	ALLOCATE( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
1449	surf_usm_h%wghf_eb_window_av = 0.0_wp
1450	ENDIF
1451	DO l = 0, 3
1452	IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_window_av) ) THEN
1453	ALLOCATE( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
1454	surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
1455	ENDIF
1456	ENDDO
1457
1458	CASE ( 'usm_wghf_green' )
1459	!-- array of heat flux from green ground (wall, roof, land)
1460	IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_green_av) ) THEN
1461	ALLOCATE( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
1462	surf_usm_h%wghf_eb_green_av = 0.0_wp
1463	ENDIF
1464	DO l = 0, 3
1465	IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_green_av) ) THEN
1466	ALLOCATE( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
1467	surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
1468	ENDIF
1469	ENDDO
1470
1471	CASE ( 'usm_iwghf' )
1472	!-- array of heat flux from indoor ground (wall, roof, land)
1473	IF ( .NOT. ALLOCATED(surf_usm_h%iwghf_eb_av) ) THEN
1474	ALLOCATE( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
1475	surf_usm_h%iwghf_eb_av = 0.0_wp
1476	ENDIF
1477	DO l = 0, 3
1478	IF ( .NOT. ALLOCATED(surf_usm_v(l)%iwghf_eb_av) ) THEN
1479	ALLOCATE( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
1480	surf_usm_v(l)%iwghf_eb_av = 0.0_wp
1481	ENDIF
1482	ENDDO
1483
1484	CASE ( 'usm_iwghf_window' )
1485	!-- array of heat flux from indoor window ground (wall, roof, land)
1486	IF ( .NOT. ALLOCATED(surf_usm_h%iwghf_eb_window_av) ) THEN
1487	ALLOCATE( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
1488	surf_usm_h%iwghf_eb_window_av = 0.0_wp
1489	ENDIF
1490	DO l = 0, 3
1491	IF ( .NOT. ALLOCATED(surf_usm_v(l)%iwghf_eb_window_av) ) THEN
1492	ALLOCATE( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
1493	surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
1494	ENDIF
1495	ENDDO
1496
1497	CASE ( 'usm_t_surf' )
1498	!-- surface temperature for surfaces
1499	IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_av) ) THEN
1500	ALLOCATE( surf_usm_h%t_surf_av(1:surf_usm_h%ns) )
1501	surf_usm_h%t_surf_av = 0.0_wp
1502	ENDIF
1503	DO l = 0, 3
1504	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_av) ) THEN
1505	ALLOCATE( surf_usm_v(l)%t_surf_av(1:surf_usm_v(l)%ns) )
1506	surf_usm_v(l)%t_surf_av = 0.0_wp
1507	ENDIF
1508	ENDDO
1509
1510	CASE ( 'usm_t_surf_window' )
1511	!-- surface temperature for window surfaces
1512	IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_window_av) ) THEN
1513	ALLOCATE( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
1514	surf_usm_h%t_surf_window_av = 0.0_wp
1515	ENDIF
1516	DO l = 0, 3
1517	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_window_av) ) THEN
1518	ALLOCATE( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
1519	surf_usm_v(l)%t_surf_window_av = 0.0_wp
1520	ENDIF
1521	ENDDO
1522
1523	CASE ( 'usm_t_surf_green' )
1524	!-- surface temperature for green surfaces
1525	IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_green_av) ) THEN
1526	ALLOCATE( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
1527	surf_usm_h%t_surf_green_av = 0.0_wp
1528	ENDIF
1529	DO l = 0, 3
1530	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_green_av) ) THEN
1531	ALLOCATE( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
1532	surf_usm_v(l)%t_surf_green_av = 0.0_wp
1533	ENDIF
1534	ENDDO
1535
1536	CASE ( 'usm_t_surf_10cm' )
1537	!-- near surface temperature for whole surfaces
1538	IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_10cm_av) ) THEN
1539	ALLOCATE( surf_usm_h%t_surf_10cm_av(1:surf_usm_h%ns) )
1540	surf_usm_h%t_surf_10cm_av = 0.0_wp
1541	ENDIF
1542	DO l = 0, 3
1543	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_10cm_av) ) THEN
1544	ALLOCATE( surf_usm_v(l)%t_surf_10cm_av(1:surf_usm_v(l)%ns) )
1545	surf_usm_v(l)%t_surf_10cm_av = 0.0_wp
1546	ENDIF
1547	ENDDO
1548
1549	CASE ( 'usm_t_wall' )
1550	!-- wall temperature for iwl layer of walls and land
1551	IF ( .NOT. ALLOCATED(surf_usm_h%t_wall_av) ) THEN
1552	ALLOCATE( surf_usm_h%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1553	surf_usm_h%t_wall_av = 0.0_wp
1554	ENDIF
1555	DO l = 0, 3
1556	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_wall_av) ) THEN
1557	ALLOCATE( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1558	surf_usm_v(l)%t_wall_av = 0.0_wp
1559	ENDIF
1560	ENDDO
1561
1562	CASE ( 'usm_t_window' )
1563	!-- window temperature for iwl layer of walls and land
1564	IF ( .NOT. ALLOCATED(surf_usm_h%t_window_av) ) THEN
1565	ALLOCATE( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1566	surf_usm_h%t_window_av = 0.0_wp
1567	ENDIF
1568	DO l = 0, 3
1569	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_window_av) ) THEN
1570	ALLOCATE( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1571	surf_usm_v(l)%t_window_av = 0.0_wp
1572	ENDIF
1573	ENDDO
1574
1575	CASE ( 'usm_t_green' )
1576	!-- green temperature for iwl layer of walls and land
1577	IF ( .NOT. ALLOCATED(surf_usm_h%t_green_av) ) THEN
1578	ALLOCATE( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
1579	surf_usm_h%t_green_av = 0.0_wp
1580	ENDIF
1581	DO l = 0, 3
1582	IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_green_av) ) THEN
1583	ALLOCATE( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
1584	surf_usm_v(l)%t_green_av = 0.0_wp
1585	ENDIF
1586	ENDDO
1587
1588	CASE DEFAULT
1589	CONTINUE
1590
1591	END SELECT
1592
1593	ELSEIF ( mode == 'sum' ) THEN
1594
1595	SELECT CASE ( TRIM( var ) )
1596
1597	CASE ( 'usm_rad_net' )
1598	!-- array of complete radiation balance
1599	DO m = 1, surf_usm_h%ns
1600	surf_usm_h%rad_net_av(m) = &
1601	surf_usm_h%rad_net_av(m) + &
1602	surf_usm_h%rad_net_l(m)
1603	ENDDO
1604	DO l = 0, 3
1605	DO m = 1, surf_usm_v(l)%ns
1606	surf_usm_v(l)%rad_net_av(m) = &
1607	surf_usm_v(l)%rad_net_av(m) + &
1608	surf_usm_v(l)%rad_net_l(m)
1609	ENDDO
1610	ENDDO
1611
1612	CASE ( 'usm_rad_insw' )
1613	!-- array of sw radiation falling to surface after i-th reflection
1614	DO l = 1, nsurfl
1615	IF ( surfl(id,l) == idsint ) THEN
1616	surfinsw_av(l) = surfinsw_av(l) + surfinsw(l)
1617	ENDIF
1618	ENDDO
1619
1620	CASE ( 'usm_rad_inlw' )
1621	!-- array of lw radiation falling to surface after i-th reflection
1622	DO l = 1, nsurfl
1623	IF ( surfl(id,l) == idsint ) THEN
1624	surfinlw_av(l) = surfinlw_av(l) + surfinlw(l)
1625	ENDIF
1626	ENDDO
1627
1628	CASE ( 'usm_rad_inswdir' )
1629	!-- array of direct sw radiation falling to surface from sun
1630	DO l = 1, nsurfl
1631	IF ( surfl(id,l) == idsint ) THEN
1632	surfinswdir_av(l) = surfinswdir_av(l) + surfinswdir(l)
1633	ENDIF
1634	ENDDO
1635
1636	CASE ( 'usm_rad_inswdif' )
1637	!-- array of difusion sw radiation falling to surface from sky and borders of the domain
1638	DO l = 1, nsurfl
1639	IF ( surfl(id,l) == idsint ) THEN
1640	surfinswdif_av(l) = surfinswdif_av(l) + surfinswdif(l)
1641	ENDIF
1642	ENDDO
1643
1644	CASE ( 'usm_rad_inswref' )
1645	!-- array of sw radiation falling to surface from reflections
1646	DO l = 1, nsurfl
1647	IF ( surfl(id,l) == idsint ) THEN
1648	surfinswref_av(l) = surfinswref_av(l) + surfinsw(l) - &
1649	surfinswdir(l) - surfinswdif(l)
1650	ENDIF
1651	ENDDO
1652
1653
1654	CASE ( 'usm_rad_inlwdif' )
1655	!-- array of sw radiation falling to surface after i-th reflection
1656	DO l = 1, nsurfl
1657	IF ( surfl(id,l) == idsint ) THEN
1658	surfinlwdif_av(l) = surfinlwdif_av(l) + surfinlwdif(l)
1659	ENDIF
1660	ENDDO
1661	!
1662	CASE ( 'usm_rad_inlwref' )
1663	!-- array of lw radiation falling to surface from reflections
1664	DO l = 1, nsurfl
1665	IF ( surfl(id,l) == idsint ) THEN
1666	surfinlwref_av(l) = surfinlwref_av(l) + &
1667	surfinlw(l) - surfinlwdif(l)
1668	ENDIF
1669	ENDDO
1670
1671	CASE ( 'usm_rad_outsw' )
1672	!-- array of sw radiation emitted from surface after i-th reflection
1673	DO l = 1, nsurfl
1674	IF ( surfl(id,l) == idsint ) THEN
1675	surfoutsw_av(l) = surfoutsw_av(l) + surfoutsw(l)
1676	ENDIF
1677	ENDDO
1678
1679	CASE ( 'usm_rad_outlw' )
1680	!-- array of lw radiation emitted from surface after i-th reflection
1681	DO l = 1, nsurfl
1682	IF ( surfl(id,l) == idsint ) THEN
1683	surfoutlw_av(l) = surfoutlw_av(l) + surfoutlw(l)
1684	ENDIF
1685	ENDDO
1686
1687	CASE ( 'usm_rad_ressw' )
1688	!-- array of residua of sw radiation absorbed in surface after last reflection
1689	DO l = 1, nsurfl
1690	IF ( surfl(id,l) == idsint ) THEN
1691	surfins_av(l) = surfins_av(l) + surfins(l)
1692	ENDIF
1693	ENDDO
1694
1695	CASE ( 'usm_rad_reslw' )
1696	!-- array of residua of lw radiation absorbed in surface after last reflection
1697	DO l = 1, nsurfl
1698	IF ( surfl(id,l) == idsint ) THEN
1699	surfinl_av(l) = surfinl_av(l) + surfinl(l)
1700	ENDIF
1701	ENDDO
1702
1703	CASE ( 'usm_rad_hf' )
1704	!-- array of heat flux from radiation for surfaces after i-th reflection
1705	DO m = 1, surf_usm_h%ns
1706	surf_usm_h%surfhf_av(m) = &
1707	surf_usm_h%surfhf_av(m) + &
1708	surf_usm_h%surfhf(m)
1709	ENDDO
1710	DO l = 0, 3
1711	DO m = 1, surf_usm_v(l)%ns
1712	surf_usm_v(l)%surfhf_av(m) = &
1713	surf_usm_v(l)%surfhf_av(m) + &
1714	surf_usm_v(l)%surfhf(m)
1715	ENDDO
1716	ENDDO
1717
1718	CASE ( 'usm_wshf' )
1719	!-- array of sensible heat flux from surfaces (land, roof, wall)
1720	DO m = 1, surf_usm_h%ns
1721	surf_usm_h%wshf_eb_av(m) = &
1722	surf_usm_h%wshf_eb_av(m) + &
1723	surf_usm_h%wshf_eb(m)
1724	ENDDO
1725	DO l = 0, 3
1726	DO m = 1, surf_usm_v(l)%ns
1727	surf_usm_v(l)%wshf_eb_av(m) = &
1728	surf_usm_v(l)%wshf_eb_av(m) + &
1729	surf_usm_v(l)%wshf_eb(m)
1730	ENDDO
1731	ENDDO
1732
1733	CASE ( 'usm_wghf' )
1734	!-- array of heat flux from ground (wall, roof, land)
1735	DO m = 1, surf_usm_h%ns
1736	surf_usm_h%wghf_eb_av(m) = &
1737	surf_usm_h%wghf_eb_av(m) + &
1738	surf_usm_h%wghf_eb(m)
1739	ENDDO
1740	DO l = 0, 3
1741	DO m = 1, surf_usm_v(l)%ns
1742	surf_usm_v(l)%wghf_eb_av(m) = &
1743	surf_usm_v(l)%wghf_eb_av(m) + &
1744	surf_usm_v(l)%wghf_eb(m)
1745	ENDDO
1746	ENDDO
1747
1748	CASE ( 'usm_wghf_window' )
1749	!-- array of heat flux from window ground (wall, roof, land)
1750	DO m = 1, surf_usm_h%ns
1751	surf_usm_h%wghf_eb_window_av(m) = &
1752	surf_usm_h%wghf_eb_window_av(m) + &
1753	surf_usm_h%wghf_eb_window(m)
1754	ENDDO
1755	DO l = 0, 3
1756	DO m = 1, surf_usm_v(l)%ns
1757	surf_usm_v(l)%wghf_eb_window_av(m) = &
1758	surf_usm_v(l)%wghf_eb_window_av(m) + &
1759	surf_usm_v(l)%wghf_eb_window(m)
1760	ENDDO
1761	ENDDO
1762
1763	CASE ( 'usm_wghf_green' )
1764	!-- array of heat flux from green ground (wall, roof, land)
1765	DO m = 1, surf_usm_h%ns
1766	surf_usm_h%wghf_eb_green_av(m) = &
1767	surf_usm_h%wghf_eb_green_av(m) + &
1768	surf_usm_h%wghf_eb_green(m)
1769	ENDDO
1770	DO l = 0, 3
1771	DO m = 1, surf_usm_v(l)%ns
1772	surf_usm_v(l)%wghf_eb_green_av(m) = &
1773	surf_usm_v(l)%wghf_eb_green_av(m) + &
1774	surf_usm_v(l)%wghf_eb_green(m)
1775	ENDDO
1776	ENDDO
1777
1778	CASE ( 'usm_iwghf' )
1779	!-- array of heat flux from indoor ground (wall, roof, land)
1780	DO m = 1, surf_usm_h%ns
1781	surf_usm_h%iwghf_eb_av(m) = &
1782	surf_usm_h%iwghf_eb_av(m) + &
1783	surf_usm_h%iwghf_eb(m)
1784	ENDDO
1785	DO l = 0, 3
1786	DO m = 1, surf_usm_v(l)%ns
1787	surf_usm_v(l)%iwghf_eb_av(m) = &
1788	surf_usm_v(l)%iwghf_eb_av(m) + &
1789	surf_usm_v(l)%iwghf_eb(m)
1790	ENDDO
1791	ENDDO
1792
1793	CASE ( 'usm_iwghf_window' )
1794	!-- array of heat flux from indoor window ground (wall, roof, land)
1795	DO m = 1, surf_usm_h%ns
1796	surf_usm_h%iwghf_eb_window_av(m) = &
1797	surf_usm_h%iwghf_eb_window_av(m) + &
1798	surf_usm_h%iwghf_eb_window(m)
1799	ENDDO
1800	DO l = 0, 3
1801	DO m = 1, surf_usm_v(l)%ns
1802	surf_usm_v(l)%iwghf_eb_window_av(m) = &
1803	surf_usm_v(l)%iwghf_eb_window_av(m) + &
1804	surf_usm_v(l)%iwghf_eb_window(m)
1805	ENDDO
1806	ENDDO
1807
1808	CASE ( 'usm_t_surf' )
1809	!-- surface temperature for surfaces
1810	DO m = 1, surf_usm_h%ns
1811	surf_usm_h%t_surf_av(m) = &
1812	surf_usm_h%t_surf_av(m) + &
1813	t_surf_h(m)
1814	ENDDO
1815	DO l = 0, 3
1816	DO m = 1, surf_usm_v(l)%ns
1817	surf_usm_v(l)%t_surf_av(m) = &
1818	surf_usm_v(l)%t_surf_av(m) + &
1819	t_surf_v(l)%t(m)
1820	ENDDO
1821	ENDDO
1822
1823	CASE ( 'usm_t_surf_window' )
1824	!-- surface temperature for window surfaces
1825	DO m = 1, surf_usm_h%ns
1826	surf_usm_h%t_surf_window_av(m) = &
1827	surf_usm_h%t_surf_window_av(m) + &
1828	t_surf_window_h(m)
1829	ENDDO
1830	DO l = 0, 3
1831	DO m = 1, surf_usm_v(l)%ns
1832	surf_usm_v(l)%t_surf_window_av(m) = &
1833	surf_usm_v(l)%t_surf_window_av(m) + &
1834	t_surf_window_v(l)%t(m)
1835	ENDDO
1836	ENDDO
1837
1838	CASE ( 'usm_t_surf_green' )
1839	!-- surface temperature for green surfaces
1840	DO m = 1, surf_usm_h%ns
1841	surf_usm_h%t_surf_green_av(m) = &
1842	surf_usm_h%t_surf_green_av(m) + &
1843	t_surf_green_h(m)
1844	ENDDO
1845	DO l = 0, 3
1846	DO m = 1, surf_usm_v(l)%ns
1847	surf_usm_v(l)%t_surf_green_av(m) = &
1848	surf_usm_v(l)%t_surf_green_av(m) + &
1849	t_surf_green_v(l)%t(m)
1850	ENDDO
1851	ENDDO
1852
1853	CASE ( 'usm_t_surf_10cm' )
1854	!-- near surface temperature for whole surfaces
1855	DO m = 1, surf_usm_h%ns
1856	surf_usm_h%t_surf_10cm_av(m) = &
1857	surf_usm_h%t_surf_10cm_av(m) + &
1858	t_surf_10cm_h(m)
1859	ENDDO
1860	DO l = 0, 3
1861	DO m = 1, surf_usm_v(l)%ns
1862	surf_usm_v(l)%t_surf_10cm_av(m) = &
1863	surf_usm_v(l)%t_surf_10cm_av(m) + &
1864	t_surf_10cm_v(l)%t(m)
1865	ENDDO
1866	ENDDO
1867
1868
1869	CASE ( 'usm_t_wall' )
1870	!-- wall temperature for iwl layer of walls and land
1871	DO m = 1, surf_usm_h%ns
1872	surf_usm_h%t_wall_av(iwl,m) = &
1873	surf_usm_h%t_wall_av(iwl,m) + &
1874	t_wall_h(iwl,m)
1875	ENDDO
1876	DO l = 0, 3
1877	DO m = 1, surf_usm_v(l)%ns
1878	surf_usm_v(l)%t_wall_av(iwl,m) = &
1879	surf_usm_v(l)%t_wall_av(iwl,m) + &
1880	t_wall_v(l)%t(iwl,m)
1881	ENDDO
1882	ENDDO
1883
1884	CASE ( 'usm_t_window' )
1885	!-- window temperature for iwl layer of walls and land
1886	DO m = 1, surf_usm_h%ns
1887	surf_usm_h%t_window_av(iwl,m) = &
1888	surf_usm_h%t_window_av(iwl,m) + &
1889	t_window_h(iwl,m)
1890	ENDDO
1891	DO l = 0, 3
1892	DO m = 1, surf_usm_v(l)%ns
1893	surf_usm_v(l)%t_window_av(iwl,m) = &
1894	surf_usm_v(l)%t_window_av(iwl,m) + &
1895	t_window_v(l)%t(iwl,m)
1896	ENDDO
1897	ENDDO
1898
1899	CASE ( 'usm_t_green' )
1900	!-- green temperature for iwl layer of walls and land
1901	DO m = 1, surf_usm_h%ns
1902	surf_usm_h%t_green_av(iwl,m) = &
1903	surf_usm_h%t_green_av(iwl,m) + &
1904	t_green_h(iwl,m)
1905	ENDDO
1906	DO l = 0, 3
1907	DO m = 1, surf_usm_v(l)%ns
1908	surf_usm_v(l)%t_green_av(iwl,m) = &
1909	surf_usm_v(l)%t_green_av(iwl,m) + &
1910	t_green_v(l)%t(iwl,m)
1911	ENDDO
1912	ENDDO
1913
1914	CASE DEFAULT
1915	CONTINUE
1916
1917	END SELECT
1918
1919	ELSEIF ( mode == 'average' ) THEN
1920
1921	SELECT CASE ( TRIM( var ) )
1922
1923	CASE ( 'usm_rad_net' )
1924	!-- array of complete radiation balance
1925	DO m = 1, surf_usm_h%ns
1926	surf_usm_h%rad_net_av(m) = &
1927	surf_usm_h%rad_net_av(m) / &
1928	REAL( average_count_3d, kind=wp )
1929	ENDDO
1930	DO l = 0, 3
1931	DO m = 1, surf_usm_v(l)%ns
1932	surf_usm_v(l)%rad_net_av(m) = &
1933	surf_usm_v(l)%rad_net_av(m) / &
1934	REAL( average_count_3d, kind=wp )
1935	ENDDO
1936	ENDDO
1937
1938	CASE ( 'usm_rad_insw' )
1939	!-- array of sw radiation falling to surface after i-th reflection
1940	DO l = 1, nsurfl
1941	IF ( surfl(id,l) == idsint ) THEN
1942	surfinsw_av(l) = surfinsw_av(l) / REAL( average_count_3d, kind=wp )
1943	ENDIF
1944	ENDDO
1945
1946	CASE ( 'usm_rad_inlw' )
1947	!-- array of lw radiation falling to surface after i-th reflection
1948	DO l = 1, nsurfl
1949	IF ( surfl(id,l) == idsint ) THEN
1950	surfinlw_av(l) = surfinlw_av(l) / REAL( average_count_3d, kind=wp )
1951	ENDIF
1952	ENDDO
1953
1954	CASE ( 'usm_rad_inswdir' )
1955	!-- array of direct sw radiation falling to surface from sun
1956	DO l = 1, nsurfl
1957	IF ( surfl(id,l) == idsint ) THEN
1958	surfinswdir_av(l) = surfinswdir_av(l) / REAL( average_count_3d, kind=wp )
1959	ENDIF
1960	ENDDO
1961
1962	CASE ( 'usm_rad_inswdif' )
1963	!-- array of difusion sw radiation falling to surface from sky and borders of the domain
1964	DO l = 1, nsurfl
1965	IF ( surfl(id,l) == idsint ) THEN
1966	surfinswdif_av(l) = surfinswdif_av(l) / REAL( average_count_3d, kind=wp )
1967	ENDIF
1968	ENDDO
1969
1970	CASE ( 'usm_rad_inswref' )
1971	!-- array of sw radiation falling to surface from reflections
1972	DO l = 1, nsurfl
1973	IF ( surfl(id,l) == idsint ) THEN
1974	surfinswref_av(l) = surfinswref_av(l) / REAL( average_count_3d, kind=wp )
1975	ENDIF
1976	ENDDO
1977
1978	CASE ( 'usm_rad_inlwdif' )
1979	!-- array of sw radiation falling to surface after i-th reflection
1980	DO l = 1, nsurfl
1981	IF ( surfl(id,l) == idsint ) THEN
1982	surfinlwdif_av(l) = surfinlwdif_av(l) / REAL( average_count_3d, kind=wp )
1983	ENDIF
1984	ENDDO
1985
1986	CASE ( 'usm_rad_inlwref' )
1987	!-- array of lw radiation falling to surface from reflections
1988	DO l = 1, nsurfl
1989	IF ( surfl(id,l) == idsint ) THEN
1990	surfinlwref_av(l) = surfinlwref_av(l) / REAL( average_count_3d, kind=wp )
1991	ENDIF
1992	ENDDO
1993
1994	CASE ( 'usm_rad_outsw' )
1995	!-- array of sw radiation emitted from surface after i-th reflection
1996	DO l = 1, nsurfl
1997	IF ( surfl(id,l) == idsint ) THEN
1998	surfoutsw_av(l) = surfoutsw_av(l) / REAL( average_count_3d, kind=wp )
1999	ENDIF
2000	ENDDO
2001
2002	CASE ( 'usm_rad_outlw' )
2003	!-- array of lw radiation emitted from surface after i-th reflection
2004	DO l = 1, nsurfl
2005	IF ( surfl(id,l) == idsint ) THEN
2006	surfoutlw_av(l) = surfoutlw_av(l) / REAL( average_count_3d, kind=wp )
2007	ENDIF
2008	ENDDO
2009
2010	CASE ( 'usm_rad_ressw' )
2011	!-- array of residua of sw radiation absorbed in surface after last reflection
2012	DO l = 1, nsurfl
2013	IF ( surfl(id,l) == idsint ) THEN
2014	surfins_av(l) = surfins_av(l) / REAL( average_count_3d, kind=wp )
2015	ENDIF
2016	ENDDO
2017
2018	CASE ( 'usm_rad_reslw' )
2019	!-- array of residua of lw radiation absorbed in surface after last reflection
2020	DO l = 1, nsurfl
2021	IF ( surfl(id,l) == idsint ) THEN
2022	surfinl_av(l) = surfinl_av(l) / REAL( average_count_3d, kind=wp )
2023	ENDIF
2024	ENDDO
2025
2026	CASE ( 'usm_rad_hf' )
2027	!-- array of heat flux from radiation for surfaces after i-th reflection
2028	DO m = 1, surf_usm_h%ns
2029	surf_usm_h%surfhf_av(m) = &
2030	surf_usm_h%surfhf_av(m) / &
2031	REAL( average_count_3d, kind=wp )
2032	ENDDO
2033	DO l = 0, 3
2034	DO m = 1, surf_usm_v(l)%ns
2035	surf_usm_v(l)%surfhf_av(m) = &
2036	surf_usm_v(l)%surfhf_av(m) / &
2037	REAL( average_count_3d, kind=wp )
2038	ENDDO
2039	ENDDO
2040
2041	CASE ( 'usm_wshf' )
2042	!-- array of sensible heat flux from surfaces (land, roof, wall)
2043	DO m = 1, surf_usm_h%ns
2044	surf_usm_h%wshf_eb_av(m) = &
2045	surf_usm_h%wshf_eb_av(m) / &
2046	REAL( average_count_3d, kind=wp )
2047	ENDDO
2048	DO l = 0, 3
2049	DO m = 1, surf_usm_v(l)%ns
2050	surf_usm_v(l)%wshf_eb_av(m) = &
2051	surf_usm_v(l)%wshf_eb_av(m) / &
2052	REAL( average_count_3d, kind=wp )
2053	ENDDO
2054	ENDDO
2055
2056	CASE ( 'usm_wghf' )
2057	!-- array of heat flux from ground (wall, roof, land)
2058	DO m = 1, surf_usm_h%ns
2059	surf_usm_h%wghf_eb_av(m) = &
2060	surf_usm_h%wghf_eb_av(m) / &
2061	REAL( average_count_3d, kind=wp )
2062	ENDDO
2063	DO l = 0, 3
2064	DO m = 1, surf_usm_v(l)%ns
2065	surf_usm_v(l)%wghf_eb_av(m) = &
2066	surf_usm_v(l)%wghf_eb_av(m) / &
2067	REAL( average_count_3d, kind=wp )
2068	ENDDO
2069	ENDDO
2070
2071	CASE ( 'usm_wghf_window' )
2072	!-- array of heat flux from window ground (wall, roof, land)
2073	DO m = 1, surf_usm_h%ns
2074	surf_usm_h%wghf_eb_window_av(m) = &
2075	surf_usm_h%wghf_eb_window_av(m) / &
2076	REAL( average_count_3d, kind=wp )
2077	ENDDO
2078	DO l = 0, 3
2079	DO m = 1, surf_usm_v(l)%ns
2080	surf_usm_v(l)%wghf_eb_window_av(m) = &
2081	surf_usm_v(l)%wghf_eb_window_av(m) / &
2082	REAL( average_count_3d, kind=wp )
2083	ENDDO
2084	ENDDO
2085
2086	CASE ( 'usm_wghf_green' )
2087	!-- array of heat flux from green ground (wall, roof, land)
2088	DO m = 1, surf_usm_h%ns
2089	surf_usm_h%wghf_eb_green_av(m) = &
2090	surf_usm_h%wghf_eb_green_av(m) / &
2091	REAL( average_count_3d, kind=wp )
2092	ENDDO
2093	DO l = 0, 3
2094	DO m = 1, surf_usm_v(l)%ns
2095	surf_usm_v(l)%wghf_eb_green_av(m) = &
2096	surf_usm_v(l)%wghf_eb_green_av(m) / &
2097	REAL( average_count_3d, kind=wp )
2098	ENDDO
2099	ENDDO
2100
2101	CASE ( 'usm_iwghf' )
2102	!-- array of heat flux from indoor ground (wall, roof, land)
2103	DO m = 1, surf_usm_h%ns
2104	surf_usm_h%iwghf_eb_av(m) = &
2105	surf_usm_h%iwghf_eb_av(m) / &
2106	REAL( average_count_3d, kind=wp )
2107	ENDDO
2108	DO l = 0, 3
2109	DO m = 1, surf_usm_v(l)%ns
2110	surf_usm_v(l)%iwghf_eb_av(m) = &
2111	surf_usm_v(l)%iwghf_eb_av(m) / &
2112	REAL( average_count_3d, kind=wp )
2113	ENDDO
2114	ENDDO
2115
2116	CASE ( 'usm_iwghf_window' )
2117	!-- array of heat flux from indoor window ground (wall, roof, land)
2118	DO m = 1, surf_usm_h%ns
2119	surf_usm_h%iwghf_eb_window_av(m) = &
2120	surf_usm_h%iwghf_eb_window_av(m) / &
2121	REAL( average_count_3d, kind=wp )
2122	ENDDO
2123	DO l = 0, 3
2124	DO m = 1, surf_usm_v(l)%ns
2125	surf_usm_v(l)%iwghf_eb_window_av(m) = &
2126	surf_usm_v(l)%iwghf_eb_window_av(m) / &
2127	REAL( average_count_3d, kind=wp )
2128	ENDDO
2129	ENDDO
2130
2131	CASE ( 'usm_t_surf' )
2132	!-- surface temperature for surfaces
2133	DO m = 1, surf_usm_h%ns
2134	surf_usm_h%t_surf_av(m) = &
2135	surf_usm_h%t_surf_av(m) / &
2136	REAL( average_count_3d, kind=wp )
2137	ENDDO
2138	DO l = 0, 3
2139	DO m = 1, surf_usm_v(l)%ns
2140	surf_usm_v(l)%t_surf_av(m) = &
2141	surf_usm_v(l)%t_surf_av(m) / &
2142	REAL( average_count_3d, kind=wp )
2143	ENDDO
2144	ENDDO
2145
2146	CASE ( 'usm_t_surf_window' )
2147	!-- surface temperature for window surfaces
2148	DO m = 1, surf_usm_h%ns
2149	surf_usm_h%t_surf_window_av(m) = &
2150	surf_usm_h%t_surf_window_av(m) / &
2151	REAL( average_count_3d, kind=wp )
2152	ENDDO
2153	DO l = 0, 3
2154	DO m = 1, surf_usm_v(l)%ns
2155	surf_usm_v(l)%t_surf_window_av(m) = &
2156	surf_usm_v(l)%t_surf_window_av(m) / &
2157	REAL( average_count_3d, kind=wp )
2158	ENDDO
2159	ENDDO
2160
2161	CASE ( 'usm_t_surf_green' )
2162	!-- surface temperature for green surfaces
2163	DO m = 1, surf_usm_h%ns
2164	surf_usm_h%t_surf_green_av(m) = &
2165	surf_usm_h%t_surf_green_av(m) / &
2166	REAL( average_count_3d, kind=wp )
2167	ENDDO
2168	DO l = 0, 3
2169	DO m = 1, surf_usm_v(l)%ns
2170	surf_usm_v(l)%t_surf_green_av(m) = &
2171	surf_usm_v(l)%t_surf_green_av(m) / &
2172	REAL( average_count_3d, kind=wp )
2173	ENDDO
2174	ENDDO
2175
2176	CASE ( 'usm_t_surf_10cm' )
2177	!-- near surface temperature for whole surfaces
2178	DO m = 1, surf_usm_h%ns
2179	surf_usm_h%t_surf_10cm_av(m) = &
2180	surf_usm_h%t_surf_10cm_av(m) / &
2181	REAL( average_count_3d, kind=wp )
2182	ENDDO
2183	DO l = 0, 3
2184	DO m = 1, surf_usm_v(l)%ns
2185	surf_usm_v(l)%t_surf_10cm_av(m) = &
2186	surf_usm_v(l)%t_surf_10cm_av(m) / &
2187	REAL( average_count_3d, kind=wp )
2188	ENDDO
2189	ENDDO
2190
2191	CASE ( 'usm_t_wall' )
2192	!-- wall temperature for iwl layer of walls and land
2193	DO m = 1, surf_usm_h%ns
2194	surf_usm_h%t_wall_av(iwl,m) = &
2195	surf_usm_h%t_wall_av(iwl,m) / &
2196	REAL( average_count_3d, kind=wp )
2197	ENDDO
2198	DO l = 0, 3
2199	DO m = 1, surf_usm_v(l)%ns
2200	surf_usm_v(l)%t_wall_av(iwl,m) = &
2201	surf_usm_v(l)%t_wall_av(iwl,m) / &
2202	REAL( average_count_3d, kind=wp )
2203	ENDDO
2204	ENDDO
2205
2206	CASE ( 'usm_t_window' )
2207	!-- window temperature for iwl layer of walls and land
2208	DO m = 1, surf_usm_h%ns
2209	surf_usm_h%t_window_av(iwl,m) = &
2210	surf_usm_h%t_window_av(iwl,m) / &
2211	REAL( average_count_3d, kind=wp )
2212	ENDDO
2213	DO l = 0, 3
2214	DO m = 1, surf_usm_v(l)%ns
2215	surf_usm_v(l)%t_window_av(iwl,m) = &
2216	surf_usm_v(l)%t_window_av(iwl,m) / &
2217	REAL( average_count_3d, kind=wp )
2218	ENDDO
2219	ENDDO
2220
2221	CASE ( 'usm_t_green' )
2222	!-- green temperature for iwl layer of walls and land
2223	DO m = 1, surf_usm_h%ns
2224	surf_usm_h%t_green_av(iwl,m) = &
2225	surf_usm_h%t_green_av(iwl,m) / &
2226	REAL( average_count_3d, kind=wp )
2227	ENDDO
2228	DO l = 0, 3
2229	DO m = 1, surf_usm_v(l)%ns
2230	surf_usm_v(l)%t_green_av(iwl,m) = &
2231	surf_usm_v(l)%t_green_av(iwl,m) / &
2232	REAL( average_count_3d, kind=wp )
2233	ENDDO
2234	ENDDO
2235
2236
2237	END SELECT
2238
2239	ENDIF
2240
2241	END SUBROUTINE usm_average_3d_data
2242
2243
2244
2245	!------------------------------------------------------------------------------!
2246	! Description:
2247	! ------------
2248	!> Set internal Neumann boundary condition at outer soil grid points
2249	!> for temperature and humidity.
2250	!------------------------------------------------------------------------------!
2251	SUBROUTINE usm_boundary_condition
2252
2253	IMPLICIT NONE
2254
2255	INTEGER(iwp) :: i !< grid index x-direction
2256	INTEGER(iwp) :: ioff !< offset index x-direction indicating location of soil grid point
2257	INTEGER(iwp) :: j !< grid index y-direction
2258	INTEGER(iwp) :: joff !< offset index x-direction indicating location of soil grid point
2259	INTEGER(iwp) :: k !< grid index z-direction
2260	INTEGER(iwp) :: koff !< offset index x-direction indicating location of soil grid point
2261	INTEGER(iwp) :: l !< running index surface-orientation
2262	INTEGER(iwp) :: m !< running index surface elements
2263
2264	koff = surf_usm_h%koff
2265	DO m = 1, surf_usm_h%ns
2266	i = surf_usm_h%i(m)
2267	j = surf_usm_h%j(m)
2268	k = surf_usm_h%k(m)
2269	pt(k+koff,j,i) = pt(k,j,i)
2270	ENDDO
2271
2272	DO l = 0, 3
2273	ioff = surf_usm_v(l)%ioff
2274	joff = surf_usm_v(l)%joff
2275	DO m = 1, surf_usm_v(l)%ns
2276	i = surf_usm_v(l)%i(m)
2277	j = surf_usm_v(l)%j(m)
2278	k = surf_usm_v(l)%k(m)
2279	pt(k,j+joff,i+ioff) = pt(k,j,i)
2280	ENDDO
2281	ENDDO
2282
2283	END SUBROUTINE usm_boundary_condition
2284
2285
2286	!------------------------------------------------------------------------------!
2287	!
2288	! Description:
2289	! ------------
2290	!> Subroutine checks variables and assigns units.
2291	!> It is called out from subroutine check_parameters.
2292	!------------------------------------------------------------------------------!
2293	SUBROUTINE usm_check_data_output( variable, unit )
2294
2295	IMPLICIT NONE
2296
2297	CHARACTER (len=*),INTENT(IN) :: variable !:
2298	CHARACTER (len=*),INTENT(OUT) :: unit !:
2299
2300	CHARACTER (len=varnamelength) :: var
2301
2302	var = TRIM(variable)
2303	IF ( var(1:12) == 'usm_rad_net_' .OR. var(1:13) == 'usm_rad_insw_' .OR. &
2304	var(1:13) == 'usm_rad_inlw_' .OR. var(1:16) == 'usm_rad_inswdir_' .OR. &
2305	var(1:16) == 'usm_rad_inswdif_' .OR. var(1:16) == 'usm_rad_inswref_' .OR. &
2306	var(1:16) == 'usm_rad_inlwdif_' .OR. var(1:16) == 'usm_rad_inlwref_' .OR. &
2307	var(1:14) == 'usm_rad_outsw_' .OR. var(1:14) == 'usm_rad_outlw_' .OR. &
2308	var(1:14) == 'usm_rad_ressw_' .OR. var(1:14) == 'usm_rad_reslw_' .OR. &
2309	var(1:11) == 'usm_rad_hf_' .OR. &
2310	var(1:9) == 'usm_wshf_' .OR. var(1:9) == 'usm_wghf_' .OR. &
2311	var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR. &
2312	var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_' ) THEN
2313	unit = 'W/m2'
2314	ELSE IF ( var(1:10) == 'usm_t_surf' .OR. var(1:10) == 'usm_t_wall' .OR. &
2315	var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR. &
2316	var(1:16) == 'usm_t_surf_green' .OR. &
2317	var(1:11) == 'usm_t_green' .OR. &
2318	var(1:15) == 'usm_t_surf_10cm') THEN
2319	unit = 'K'
2320	ELSE IF ( var(1:9) == 'usm_surfz' .OR. var(1:7) == 'usm_svf' .OR. &
2321	var(1:7) == 'usm_dif' .OR. var(1:11) == 'usm_surfcat' .OR. &
2322	var(1:11) == 'usm_surfalb' .OR. var(1:12) == 'usm_surfemis' .OR. &
2323	var(1:9) == 'usm_skyvf' .OR. var(1:9) == 'usm_skyvft' ) THEN
2324	unit = '1'
2325	ELSE
2326	unit = 'illegal'
2327	ENDIF
2328
2329	END SUBROUTINE usm_check_data_output
2330
2331
2332	!------------------------------------------------------------------------------!
2333	! Description:
2334	! ------------
2335	!> Check parameters routine for urban surface model
2336	!------------------------------------------------------------------------------!
2337	SUBROUTINE usm_check_parameters
2338
2339	USE control_parameters, &
2340	ONLY: bc_pt_b, bc_q_b, constant_flux_layer, large_scale_forcing, &
2341	lsf_surf, topography
2342
2343	!
2344	!-- Dirichlet boundary conditions are required as the surface fluxes are
2345	!-- calculated from the temperature/humidity gradients in the urban surface
2346	!-- model
2347	IF ( bc_pt_b == 'neumann' .OR. bc_q_b == 'neumann' ) THEN
2348	message_string = 'urban surface model requires setting of '// &
2349	'bc_pt_b = "dirichlet" and '// &
2350	'bc_q_b = "dirichlet"'
2351	CALL message( 'usm_check_parameters', 'PA0590', 1, 2, 0, 6, 0 )
2352	ENDIF
2353
2354	IF ( .NOT. constant_flux_layer ) THEN
2355	message_string = 'urban surface model requires '// &
2356	'constant_flux_layer = .T.'
2357	CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2358	ENDIF
2359
2360	IF ( .NOT. radiation ) THEN
2361	message_string = 'urban surface model requires '// &
2362	'the radiation model to be switched on'
2363	CALL message( 'usm_check_parameters', 'PA0084', 1, 2, 0, 6, 0 )
2364	ENDIF
2365	!
2366	!-- Surface forcing has to be disabled for LSF in case of enabled
2367	!-- urban surface module
2368	IF ( large_scale_forcing ) THEN
2369	lsf_surf = .FALSE.
2370	ENDIF
2371	!
2372	!-- Topography
2373	IF ( topography == 'flat' ) THEN
2374	message_string = 'topography /= "flat" is required '// &
2375	'when using the urban surface model'
2376	CALL message( 'check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
2377	ENDIF
2378	!
2379	!-- naheatlayers
2380	IF ( naheatlayers > nzt ) THEN
2381	message_string = 'number of anthropogenic heat layers '// &
2382	'"naheatlayers" can not be larger than'// &
2383	' number of domain layers "nzt"'
2384	CALL message( 'check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
2385	ENDIF
2386
2387	END SUBROUTINE usm_check_parameters
2388
2389
2390	!------------------------------------------------------------------------------!
2391	!
2392	! Description:
2393	! ------------
2394	!> Output of the 3D-arrays in netCDF and/or AVS format
2395	!> for variables of urban_surface model.
2396	!> It resorts the urban surface module output quantities from surf style
2397	!> indexing into temporary 3D array with indices (i,j,k).
2398	!> It is called from subroutine data_output_3d.
2399	!------------------------------------------------------------------------------!
2400	SUBROUTINE usm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
2401
2402	IMPLICIT NONE
2403
2404	INTEGER(iwp), INTENT(IN) :: av !<
2405	CHARACTER (len=*), INTENT(IN) :: variable !<
2406	INTEGER(iwp), INTENT(IN) :: nzb_do !< lower limit of the data output (usually 0)
2407	INTEGER(iwp), INTENT(IN) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
2408	LOGICAL, INTENT(OUT) :: found !<
2409	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< sp - it has to correspond to module data_output_3d
2410	REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: temp_pf !< temp array for urban surface output procedure
2411
2412	CHARACTER (len=varnamelength) :: var, surfid
2413	INTEGER(iwp), PARAMETER :: nd = 5
2414	CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
2415	INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
2416	INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: diridx = (/ -1, 1, 0, 3, 2 /)
2417	!< index for surf_*_v: 0:3 = (North, South, East, West)
2418	INTEGER(iwp), DIMENSION(0:nd-1) :: dirstart
2419	INTEGER(iwp), DIMENSION(0:nd-1) :: dirend
2420	INTEGER(iwp) :: ids,idsint,idsidx,isurf,isvf,isurfs,isurflt
2421	INTEGER(iwp) :: is,js,ks,i,j,k,iwl,istat, l, m
2422	INTEGER(iwp) :: k_topo !< topography top index
2423
2424	dirstart = (/ startland, startwall, startwall, startwall, startwall /)
2425	dirend = (/ endland, endwall, endwall, endwall, endwall /)
2426
2427	found = .TRUE.
2428	temp_pf = -1._wp
2429
2430	ids = -1
2431	var = TRIM(variable)
2432	DO i = 0, nd-1
2433	k = len(TRIM(var))
2434	j = len(TRIM(dirname(i)))
2435	IF ( var(k-j+1:k) == dirname(i) ) THEN
2436	ids = i
2437	idsint = dirint(ids)
2438	idsidx = diridx(ids)
2439	var = var(:k-j)
2440	EXIT
2441	ENDIF
2442	ENDDO
2443	IF ( ids == -1 ) THEN
2444	var = TRIM(variable)
2445	ENDIF
2446	IF ( var(1:11) == 'usm_t_wall_' .AND. len(TRIM(var)) >= 12 ) THEN
2447	!-- wall layers
2448	READ(var(12:12), '(I1)', iostat=istat ) iwl
2449	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
2450	var = var(1:10)
2451	ENDIF
2452	ENDIF
2453	IF ( var(1:13) == 'usm_t_window_' .AND. len(TRIM(var)) >= 14 ) THEN
2454	!-- window layers
2455	READ(var(14:14), '(I1)', iostat=istat ) iwl
2456	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
2457	var = var(1:12)
2458	ENDIF
2459	ENDIF
2460	IF ( var(1:12) == 'usm_t_green_' .AND. len(TRIM(var)) >= 13 ) THEN
2461	!-- green layers
2462	READ(var(13:13), '(I1)', iostat=istat ) iwl
2463	IF ( istat == 0 .AND. iwl >= nzb_wall .AND. iwl <= nzt_wall ) THEN
2464	var = var(1:11)
2465	ENDIF
2466	ENDIF
2467	IF ( (var(1:8) == 'usm_svf_' .OR. var(1:8) == 'usm_dif_') .AND. len(TRIM(var)) >= 13 ) THEN
2468	!-- svf values to particular surface
2469	surfid = var(9:)
2470	i = index(surfid,'_')
2471	j = index(surfid(i+1:),'_')
2472	READ(surfid(1:i-1),*, iostat=istat ) is
2473	IF ( istat == 0 ) THEN
2474	READ(surfid(i+1:i+j-1),*, iostat=istat ) js
2475	ENDIF
2476	IF ( istat == 0 ) THEN
2477	READ(surfid(i+j+1:),*, iostat=istat ) ks
2478	ENDIF
2479	IF ( istat == 0 ) THEN
2480	var = var(1:7)
2481	ENDIF
2482	ENDIF
2483
2484	SELECT CASE ( TRIM(var) )
2485
2486	CASE ( 'usm_surfz' )
2487	!-- array of lw radiation falling to local surface after i-th reflection
2488	IF ( idsint == iup_u ) THEN
2489	DO m = 1, surf_usm_h%ns
2490	i = surf_usm_h%i(m)
2491	j = surf_usm_h%j(m)
2492	k = surf_usm_h%k(m)
2493	temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, kind=wp) )
2494	ENDDO
2495	ELSE
2496	l = idsidx
2497	DO m = 1, surf_usm_v(l)%ns
2498	i = surf_usm_v(l)%i(m)
2499	j = surf_usm_v(l)%j(m)
2500	k = surf_usm_v(l)%k(m)
2501	temp_pf(0,j,i) = MAX( temp_pf(0,j,i), REAL( k, kind=wp) + 1.0_wp )
2502	ENDDO
2503	ENDIF
2504
2505	CASE ( 'usm_surfcat' )
2506	!-- surface category
2507	IF ( idsint == iup_u ) THEN
2508	DO m = 1, surf_usm_h%ns
2509	i = surf_usm_h%i(m)
2510	j = surf_usm_h%j(m)
2511	k = surf_usm_h%k(m)
2512	temp_pf(k,j,i) = surf_usm_h%surface_types(m)
2513	ENDDO
2514	ELSE
2515	l = idsidx
2516	DO m = 1, surf_usm_v(l)%ns
2517	i = surf_usm_v(l)%i(m)
2518	j = surf_usm_v(l)%j(m)
2519	k = surf_usm_v(l)%k(m)
2520	temp_pf(k,j,i) = surf_usm_v(l)%surface_types(m)
2521	ENDDO
2522	ENDIF
2523
2524	CASE ( 'usm_surfalb' )
2525	!-- surface albedo, weighted average
2526	IF ( idsint == iup_u ) THEN
2527	DO m = 1, surf_usm_h%ns
2528	i = surf_usm_h%i(m)
2529	j = surf_usm_h%j(m)
2530	k = surf_usm_h%k(m)
2531	temp_pf(k,j,i) = surf_usm_h%frac(ind_veg_wall,m) * &
2532	surf_usm_h%albedo(ind_veg_wall,m) + &
2533	surf_usm_h%frac(ind_pav_green,m) * &
2534	surf_usm_h%albedo(ind_pav_green,m) + &
2535	surf_usm_h%frac(ind_wat_win,m) * &
2536	surf_usm_h%albedo(ind_wat_win,m)
2537	ENDDO
2538	ELSE
2539	l = idsidx
2540	DO m = 1, surf_usm_v(l)%ns
2541	i = surf_usm_v(l)%i(m)
2542	j = surf_usm_v(l)%j(m)
2543	k = surf_usm_v(l)%k(m)
2544	temp_pf(k,j,i) = surf_usm_v(l)%frac(ind_veg_wall,m) * &
2545	surf_usm_v(l)%albedo(ind_veg_wall,m) + &
2546	surf_usm_v(l)%frac(ind_pav_green,m) * &
2547	surf_usm_v(l)%albedo(ind_pav_green,m) + &
2548	surf_usm_v(l)%frac(ind_wat_win,m) * &
2549	surf_usm_v(l)%albedo(ind_wat_win,m)
2550	ENDDO
2551	ENDIF
2552
2553	CASE ( 'usm_surfemis' )
2554	!-- surface emissivity, weighted average
2555	IF ( idsint == iup_u ) THEN
2556	DO m = 1, surf_usm_h%ns
2557	i = surf_usm_h%i(m)
2558	j = surf_usm_h%j(m)
2559	k = surf_usm_h%k(m)
2560	temp_pf(k,j,i) = surf_usm_h%frac(ind_veg_wall,m) * &
2561	surf_usm_h%emissivity(ind_veg_wall,m) + &
2562	surf_usm_h%frac(ind_pav_green,m) * &
2563	surf_usm_h%emissivity(ind_pav_green,m) + &
2564	surf_usm_h%frac(ind_wat_win,m) * &
2565	surf_usm_h%emissivity(ind_wat_win,m)
2566	ENDDO
2567	ELSE
2568	l = idsidx
2569	DO m = 1, surf_usm_v(l)%ns
2570	i = surf_usm_v(l)%i(m)
2571	j = surf_usm_v(l)%j(m)
2572	k = surf_usm_v(l)%k(m)
2573	temp_pf(k,j,i) = surf_usm_v(l)%frac(ind_veg_wall,m) *&
2574	surf_usm_v(l)%emissivity(ind_veg_wall,m) +&
2575	surf_usm_v(l)%frac(ind_pav_green,m) *&
2576	surf_usm_v(l)%emissivity(ind_pav_green,m)+&
2577	surf_usm_v(l)%frac(ind_wat_win,m) *&
2578	surf_usm_v(l)%emissivity(ind_wat_win,m)
2579	ENDDO
2580	ENDIF
2581
2582	CASE ( 'usm_surfwintrans' )
2583	!-- transmissivity window tiles
2584	IF ( idsint == iup_u ) THEN
2585	DO m = 1, surf_usm_h%ns
2586	i = surf_usm_h%i(m)
2587	j = surf_usm_h%j(m)
2588	k = surf_usm_h%k(m)
2589	temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
2590	ENDDO
2591	ELSE
2592	l = idsidx
2593	DO m = 1, surf_usm_v(l)%ns
2594	i = surf_usm_v(l)%i(m)
2595	j = surf_usm_v(l)%j(m)
2596	k = surf_usm_v(l)%k(m)
2597	temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
2598	ENDDO
2599	ENDIF
2600
2601	CASE ( 'usm_skyvf' )
2602	!-- sky view factor
2603	DO isurf = dirstart(ids), dirend(ids)
2604	IF ( surfl(id,isurf) == idsint ) THEN
2605	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = skyvf(isurf)
2606	ENDIF
2607	ENDDO
2608
2609	CASE ( 'usm_skyvft' )
2610	!-- sky view factor
2611	DO isurf = dirstart(ids), dirend(ids)
2612	IF ( surfl(id,isurf) == ids ) THEN
2613	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = skyvft(isurf)
2614	ENDIF
2615	ENDDO
2616
2617	!
2618	!-- Not adjusted so far
2619	CASE ( 'usm_svf', 'usm_dif' )
2620	!-- shape view factors or iradiance factors to selected surface
2621	IF ( TRIM(var)=='usm_svf' ) THEN
2622	k = 1
2623	ELSE
2624	k = 2
2625	ENDIF
2626	DO isvf = 1, nsvfl
2627	isurflt = svfsurf(1, isvf)
2628	isurfs = svfsurf(2, isvf)
2629
2630	IF ( surf(ix,isurfs) == is .AND. surf(iy,isurfs) == js .AND. &
2631	surf(iz,isurfs) == ks .AND. surf(id,isurfs) == idsint ) THEN
2632	!-- correct source surface
2633	temp_pf(surfl(iz,isurflt),surfl(iy,isurflt),surfl(ix,isurflt)) = svf(k,isvf)
2634	ENDIF
2635	ENDDO
2636
2637	CASE ( 'usm_rad_net' )
2638	!-- array of complete radiation balance
2639	IF ( av == 0 ) THEN
2640	IF ( idsint == iup_u ) THEN
2641	DO m = 1, surf_usm_h%ns
2642	i = surf_usm_h%i(m)
2643	j = surf_usm_h%j(m)
2644	k = surf_usm_h%k(m)
2645	temp_pf(k,j,i) = surf_usm_h%rad_net_l(m)
2646	ENDDO
2647	ELSE
2648	l = idsidx
2649	DO m = 1, surf_usm_v(l)%ns
2650	i = surf_usm_v(l)%i(m)
2651	j = surf_usm_v(l)%j(m)
2652	k = surf_usm_v(l)%k(m)
2653	temp_pf(k,j,i) = surf_usm_v(l)%rad_net_l(m)
2654	ENDDO
2655	ENDIF
2656	ELSE
2657	IF ( idsint == iup_u ) THEN
2658	DO m = 1, surf_usm_h%ns
2659	i = surf_usm_h%i(m)
2660	j = surf_usm_h%j(m)
2661	k = surf_usm_h%k(m)
2662	temp_pf(k,j,i) = surf_usm_h%rad_net_av(m)
2663	ENDDO
2664	ELSE
2665	l = idsidx
2666	DO m = 1, surf_usm_v(l)%ns
2667	i = surf_usm_v(l)%i(m)
2668	j = surf_usm_v(l)%j(m)
2669	k = surf_usm_v(l)%k(m)
2670	temp_pf(k,j,i) = surf_usm_v(l)%rad_net_av(m)
2671	ENDDO
2672	ENDIF
2673	ENDIF
2674
2675	CASE ( 'usm_rad_insw' )
2676	!-- array of sw radiation falling to surface after i-th reflection
2677	DO isurf = dirstart(ids), dirend(ids)
2678	IF ( surfl(id,isurf) == idsint ) THEN
2679	IF ( av == 0 ) THEN
2680	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinsw(isurf)
2681	ELSE
2682	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinsw_av(isurf)
2683	ENDIF
2684	ENDIF
2685	ENDDO
2686
2687	CASE ( 'usm_rad_inlw' )
2688	!-- array of lw radiation falling to surface after i-th reflection
2689	DO isurf = dirstart(ids), dirend(ids)
2690	IF ( surfl(id,isurf) == idsint ) THEN
2691	IF ( av == 0 ) THEN
2692	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlw(isurf)
2693	ELSE
2694	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlw_av(isurf)
2695	ENDIF
2696	ENDIF
2697	ENDDO
2698
2699	CASE ( 'usm_rad_inswdir' )
2700	!-- array of direct sw radiation falling to surface from sun
2701	DO isurf = dirstart(ids), dirend(ids)
2702	IF ( surfl(id,isurf) == idsint ) THEN
2703	IF ( av == 0 ) THEN
2704	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinswdir(isurf)
2705	ELSE
2706	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinswdir_av(isurf)
2707	ENDIF
2708	ENDIF
2709	ENDDO
2710
2711	CASE ( 'usm_rad_inswdif' )
2712	!-- array of difusion sw radiation falling to surface from sky and borders of the domain
2713	DO isurf = dirstart(ids), dirend(ids)
2714	IF ( surfl(id,isurf) == idsint ) THEN
2715	IF ( av == 0 ) THEN
2716	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinswdif(isurf)
2717	ELSE
2718	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinswdif_av(isurf)
2719	ENDIF
2720	ENDIF
2721	ENDDO
2722
2723	CASE ( 'usm_rad_inswref' )
2724	!-- array of sw radiation falling to surface from reflections
2725	DO isurf = dirstart(ids), dirend(ids)
2726	IF ( surfl(id,isurf) == idsint ) THEN
2727	IF ( av == 0 ) THEN
2728	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = &
2729	surfinsw(isurf) - surfinswdir(isurf) - surfinswdif(isurf)
2730	ELSE
2731	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinswref_av(isurf)
2732	ENDIF
2733	ENDIF
2734	ENDDO
2735
2736	CASE ( 'usm_rad_inlwdif' )
2737	!-- array of difusion lw radiation falling to surface from sky and borders of the domain
2738	DO isurf = dirstart(ids), dirend(ids)
2739	IF ( surfl(id,isurf) == idsint ) THEN
2740	IF ( av == 0 ) THEN
2741	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlwdif(isurf)
2742	ELSE
2743	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlwdif_av(isurf)
2744	ENDIF
2745	ENDIF
2746	ENDDO
2747
2748	CASE ( 'usm_rad_inlwref' )
2749	!-- array of lw radiation falling to surface from reflections
2750	DO isurf = dirstart(ids), dirend(ids)
2751	IF ( surfl(id,isurf) == idsint ) THEN
2752	IF ( av == 0 ) THEN
2753	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlw(isurf) - surfinlwdif(isurf)
2754	ELSE
2755	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinlwref_av(isurf)
2756	ENDIF
2757	ENDIF
2758	ENDDO
2759
2760	CASE ( 'usm_rad_outsw' )
2761	!-- array of sw radiation emitted from surface after i-th reflection
2762	DO isurf = dirstart(ids), dirend(ids)
2763	IF ( surfl(id,isurf) == idsint ) THEN
2764	IF ( av == 0 ) THEN
2765	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfoutsw(isurf)
2766	ELSE
2767	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfoutsw_av(isurf)
2768	ENDIF
2769	ENDIF
2770	ENDDO
2771
2772	CASE ( 'usm_rad_outlw' )
2773	!-- array of lw radiation emitted from surface after i-th reflection
2774	DO isurf = dirstart(ids), dirend(ids)
2775	IF ( surfl(id,isurf) == idsint ) THEN
2776	IF ( av == 0 ) THEN
2777	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfoutlw(isurf)
2778	ELSE
2779	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfoutlw_av(isurf)
2780	ENDIF
2781	ENDIF
2782	ENDDO
2783
2784	CASE ( 'usm_rad_ressw' )
2785	!-- average of array of residua of sw radiation absorbed in surface after last reflection
2786	DO isurf = dirstart(ids), dirend(ids)
2787	IF ( surfl(id,isurf) == idsint ) THEN
2788	IF ( av == 0 ) THEN
2789	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfins(isurf)
2790	ELSE
2791	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfins_av(isurf)
2792	ENDIF
2793	ENDIF
2794	ENDDO
2795
2796	CASE ( 'usm_rad_reslw' )
2797	!-- average of array of residua of lw radiation absorbed in surface after last reflection
2798	DO isurf = dirstart(ids), dirend(ids)
2799	IF ( surfl(id,isurf) == idsint ) THEN
2800	IF ( av == 0 ) THEN
2801	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinl(isurf)
2802	ELSE
2803	temp_pf(surfl(iz,isurf),surfl(iy,isurf),surfl(ix,isurf)) = surfinl_av(isurf)
2804	ENDIF
2805	ENDIF
2806	ENDDO
2807
2808	CASE ( 'usm_rad_hf' )
2809	!-- array of heat flux from radiation for surfaces after all reflections
2810	IF ( av == 0 ) THEN
2811	IF ( idsint == iup_u ) THEN
2812	DO m = 1, surf_usm_h%ns
2813	i = surf_usm_h%i(m)
2814	j = surf_usm_h%j(m)
2815	k = surf_usm_h%k(m)
2816	temp_pf(k,j,i) = surf_usm_h%surfhf(m)
2817	ENDDO
2818	ELSE
2819	l = idsidx
2820	DO m = 1, surf_usm_v(l)%ns
2821	i = surf_usm_v(l)%i(m)
2822	j = surf_usm_v(l)%j(m)
2823	k = surf_usm_v(l)%k(m)
2824	temp_pf(k,j,i) = surf_usm_v(l)%surfhf(m)
2825	ENDDO
2826	ENDIF
2827	ELSE
2828	IF ( idsint == iup_u ) THEN
2829	DO m = 1, surf_usm_h%ns
2830	i = surf_usm_h%i(m)
2831	j = surf_usm_h%j(m)
2832	k = surf_usm_h%k(m)
2833	temp_pf(k,j,i) = surf_usm_h%surfhf_av(m)
2834	ENDDO
2835	ELSE
2836	l = idsidx
2837	DO m = 1, surf_usm_v(l)%ns
2838	i = surf_usm_v(l)%i(m)
2839	j = surf_usm_v(l)%j(m)
2840	k = surf_usm_v(l)%k(m)
2841	temp_pf(k,j,i) = surf_usm_v(l)%surfhf_av(m)
2842	ENDDO
2843	ENDIF
2844	ENDIF
2845
2846	CASE ( 'usm_wshf' )
2847	!-- array of sensible heat flux from surfaces
2848	IF ( av == 0 ) THEN
2849	IF ( idsint == iup_u ) THEN
2850	DO m = 1, surf_usm_h%ns
2851	i = surf_usm_h%i(m)
2852	j = surf_usm_h%j(m)
2853	k = surf_usm_h%k(m)
2854	temp_pf(k,j,i) = surf_usm_h%wshf_eb(m)
2855	ENDDO
2856	ELSE
2857	l = idsidx
2858	DO m = 1, surf_usm_v(l)%ns
2859	i = surf_usm_v(l)%i(m)
2860	j = surf_usm_v(l)%j(m)
2861	k = surf_usm_v(l)%k(m)
2862	temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb(m)
2863	ENDDO
2864	ENDIF
2865	ELSE
2866	IF ( idsint == iup_u ) THEN
2867	DO m = 1, surf_usm_h%ns
2868	i = surf_usm_h%i(m)
2869	j = surf_usm_h%j(m)
2870	k = surf_usm_h%k(m)
2871	temp_pf(k,j,i) = surf_usm_h%wshf_eb_av(m)
2872	ENDDO
2873	ELSE
2874	l = idsidx
2875	DO m = 1, surf_usm_v(l)%ns
2876	i = surf_usm_v(l)%i(m)
2877	j = surf_usm_v(l)%j(m)
2878	k = surf_usm_v(l)%k(m)
2879	temp_pf(k,j,i) = surf_usm_v(l)%wshf_eb_av(m)
2880	ENDDO
2881	ENDIF
2882	ENDIF
2883
2884
2885	CASE ( 'usm_wghf' )
2886	!-- array of heat flux from ground (land, wall, roof)
2887	IF ( av == 0 ) THEN
2888	IF ( idsint == iup_u ) THEN
2889	DO m = 1, surf_usm_h%ns
2890	i = surf_usm_h%i(m)
2891	j = surf_usm_h%j(m)
2892	k = surf_usm_h%k(m)
2893	temp_pf(k,j,i) = surf_usm_h%wghf_eb(m)
2894	ENDDO
2895	ELSE
2896	l = idsidx
2897	DO m = 1, surf_usm_v(l)%ns
2898	i = surf_usm_v(l)%i(m)
2899	j = surf_usm_v(l)%j(m)
2900	k = surf_usm_v(l)%k(m)
2901	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb(m)
2902	ENDDO
2903	ENDIF
2904	ELSE
2905	IF ( idsint == iup_u ) THEN
2906	DO m = 1, surf_usm_h%ns
2907	i = surf_usm_h%i(m)
2908	j = surf_usm_h%j(m)
2909	k = surf_usm_h%k(m)
2910	temp_pf(k,j,i) = surf_usm_h%wghf_eb_av(m)
2911	ENDDO
2912	ELSE
2913	l = idsidx
2914	DO m = 1, surf_usm_v(l)%ns
2915	i = surf_usm_v(l)%i(m)
2916	j = surf_usm_v(l)%j(m)
2917	k = surf_usm_v(l)%k(m)
2918	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_av(m)
2919	ENDDO
2920	ENDIF
2921	ENDIF
2922
2923	CASE ( 'usm_wghf_window' )
2924	!-- array of heat flux from window ground (land, wall, roof)
2925
2926	IF ( av == 0 ) THEN
2927	IF ( idsint == iup_u ) THEN
2928	DO m = 1, surf_usm_h%ns
2929	i = surf_usm_h%i(m)
2930	j = surf_usm_h%j(m)
2931	k = surf_usm_h%k(m)
2932	temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
2933	ENDDO
2934	ELSE
2935	l = idsidx
2936	DO m = 1, surf_usm_v(l)%ns
2937	i = surf_usm_v(l)%i(m)
2938	j = surf_usm_v(l)%j(m)
2939	k = surf_usm_v(l)%k(m)
2940	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
2941	ENDDO
2942	ENDIF
2943	ELSE
2944	IF ( idsint == iup_u ) THEN
2945	DO m = 1, surf_usm_h%ns
2946	i = surf_usm_h%i(m)
2947	j = surf_usm_h%j(m)
2948	k = surf_usm_h%k(m)
2949	temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
2950	ENDDO
2951	ELSE
2952	l = idsidx
2953	DO m = 1, surf_usm_v(l)%ns
2954	i = surf_usm_v(l)%i(m)
2955	j = surf_usm_v(l)%j(m)
2956	k = surf_usm_v(l)%k(m)
2957	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
2958	ENDDO
2959	ENDIF
2960	ENDIF
2961
2962	CASE ( 'usm_wghf_green' )
2963	!-- array of heat flux from green ground (land, wall, roof)
2964
2965	IF ( av == 0 ) THEN
2966	IF ( idsint == iup_u ) THEN
2967	DO m = 1, surf_usm_h%ns
2968	i = surf_usm_h%i(m)
2969	j = surf_usm_h%j(m)
2970	k = surf_usm_h%k(m)
2971	temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
2972	ENDDO
2973	ELSE
2974	l = idsidx
2975	DO m = 1, surf_usm_v(l)%ns
2976	i = surf_usm_v(l)%i(m)
2977	j = surf_usm_v(l)%j(m)
2978	k = surf_usm_v(l)%k(m)
2979	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
2980	ENDDO
2981	ENDIF
2982	ELSE
2983	IF ( idsint == iup_u ) THEN
2984	DO m = 1, surf_usm_h%ns
2985	i = surf_usm_h%i(m)
2986	j = surf_usm_h%j(m)
2987	k = surf_usm_h%k(m)
2988	temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
2989	ENDDO
2990	ELSE
2991	l = idsidx
2992	DO m = 1, surf_usm_v(l)%ns
2993	i = surf_usm_v(l)%i(m)
2994	j = surf_usm_v(l)%j(m)
2995	k = surf_usm_v(l)%k(m)
2996	temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
2997	ENDDO
2998	ENDIF
2999	ENDIF
3000
3001	CASE ( 'usm_iwghf' )
3002	!-- array of heat flux from indoor ground (land, wall, roof)
3003	IF ( av == 0 ) THEN
3004	IF ( idsint == iup_u ) THEN
3005	DO m = 1, surf_usm_h%ns
3006	i = surf_usm_h%i(m)
3007	j = surf_usm_h%j(m)
3008	k = surf_usm_h%k(m)
3009	temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
3010	ENDDO
3011	ELSE
3012	l = idsidx
3013	DO m = 1, surf_usm_v(l)%ns
3014	i = surf_usm_v(l)%i(m)
3015	j = surf_usm_v(l)%j(m)
3016	k = surf_usm_v(l)%k(m)
3017	temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
3018	ENDDO
3019	ENDIF
3020	ELSE
3021	IF ( idsint == iup_u ) THEN
3022	DO m = 1, surf_usm_h%ns
3023	i = surf_usm_h%i(m)
3024	j = surf_usm_h%j(m)
3025	k = surf_usm_h%k(m)
3026	temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
3027	ENDDO
3028	ELSE
3029	l = idsidx
3030	DO m = 1, surf_usm_v(l)%ns
3031	i = surf_usm_v(l)%i(m)
3032	j = surf_usm_v(l)%j(m)
3033	k = surf_usm_v(l)%k(m)
3034	temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
3035	ENDDO
3036	ENDIF
3037	ENDIF
3038
3039	CASE ( 'usm_iwghf_window' )
3040	!-- array of heat flux from indoor window ground (land, wall, roof)
3041
3042	IF ( av == 0 ) THEN
3043	IF ( idsint == iup_u ) THEN
3044	DO m = 1, surf_usm_h%ns
3045	i = surf_usm_h%i(m)
3046	j = surf_usm_h%j(m)
3047	k = surf_usm_h%k(m)
3048	temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(m)
3049	ENDDO
3050	ELSE
3051	l = idsidx
3052	DO m = 1, surf_usm_v(l)%ns
3053	i = surf_usm_v(l)%i(m)
3054	j = surf_usm_v(l)%j(m)
3055	k = surf_usm_v(l)%k(m)
3056	temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
3057	ENDDO
3058	ENDIF
3059	ELSE
3060	IF ( idsint == iup_u ) THEN
3061	DO m = 1, surf_usm_h%ns
3062	i = surf_usm_h%i(m)
3063	j = surf_usm_h%j(m)
3064	k = surf_usm_h%k(m)
3065	temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
3066	ENDDO
3067	ELSE
3068	l = idsidx
3069	DO m = 1, surf_usm_v(l)%ns
3070	i = surf_usm_v(l)%i(m)
3071	j = surf_usm_v(l)%j(m)
3072	k = surf_usm_v(l)%k(m)
3073	temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
3074	ENDDO
3075	ENDIF
3076	ENDIF
3077
3078	CASE ( 'usm_t_surf' )
3079	!-- surface temperature for surfaces
3080	IF ( av == 0 ) THEN
3081	IF ( idsint == iup_u ) THEN
3082	DO m = 1, surf_usm_h%ns
3083	i = surf_usm_h%i(m)
3084	j = surf_usm_h%j(m)
3085	k = surf_usm_h%k(m)
3086	temp_pf(k,j,i) = t_surf_h(m)
3087	ENDDO
3088	ELSE
3089	l = idsidx
3090	DO m = 1, surf_usm_v(l)%ns
3091	i = surf_usm_v(l)%i(m)
3092	j = surf_usm_v(l)%j(m)
3093	k = surf_usm_v(l)%k(m)
3094	temp_pf(k,j,i) = t_surf_v(l)%t(m)
3095	ENDDO
3096	ENDIF
3097	ELSE
3098	IF ( idsint == iup_u ) THEN
3099	DO m = 1, surf_usm_h%ns
3100	i = surf_usm_h%i(m)
3101	j = surf_usm_h%j(m)
3102	k = surf_usm_h%k(m)
3103	temp_pf(k,j,i) = surf_usm_h%t_surf_av(m)
3104	ENDDO
3105	ELSE
3106	l = idsidx
3107	DO m = 1, surf_usm_v(l)%ns
3108	i = surf_usm_v(l)%i(m)
3109	j = surf_usm_v(l)%j(m)
3110	k = surf_usm_v(l)%k(m)
3111	temp_pf(k,j,i) = surf_usm_v(l)%t_surf_av(m)
3112	ENDDO
3113	ENDIF
3114	ENDIF
3115
3116	CASE ( 'usm_t_surf_window' )
3117	!-- surface temperature for window surfaces
3118
3119	IF ( av == 0 ) THEN
3120	IF ( idsint == iup_u ) THEN
3121	DO m = 1, surf_usm_h%ns
3122	i = surf_usm_h%i(m)
3123	j = surf_usm_h%j(m)
3124	k = surf_usm_h%k(m)
3125	temp_pf(k,j,i) = t_surf_window_h(m)
3126	ENDDO
3127	ELSE
3128	l = idsidx
3129	DO m = 1, surf_usm_v(l)%ns
3130	i = surf_usm_v(l)%i(m)
3131	j = surf_usm_v(l)%j(m)
3132	k = surf_usm_v(l)%k(m)
3133	temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
3134	ENDDO
3135	ENDIF
3136
3137	ELSE
3138	IF ( idsint == iup_u ) THEN
3139	DO m = 1, surf_usm_h%ns
3140	i = surf_usm_h%i(m)
3141	j = surf_usm_h%j(m)
3142	k = surf_usm_h%k(m)
3143	temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
3144	ENDDO
3145	ELSE
3146	l = idsidx
3147	DO m = 1, surf_usm_v(l)%ns
3148	i = surf_usm_v(l)%i(m)
3149	j = surf_usm_v(l)%j(m)
3150	k = surf_usm_v(l)%k(m)
3151	temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
3152	ENDDO
3153
3154	ENDIF
3155
3156	ENDIF
3157
3158	CASE ( 'usm_t_surf_green' )
3159	!-- surface temperature for green surfaces
3160
3161	IF ( av == 0 ) THEN
3162	IF ( idsint == iup_u ) THEN
3163	DO m = 1, surf_usm_h%ns
3164	i = surf_usm_h%i(m)
3165	j = surf_usm_h%j(m)
3166	k = surf_usm_h%k(m)
3167	temp_pf(k,j,i) = t_surf_green_h(m)
3168	ENDDO
3169	ELSE
3170	l = idsidx
3171	DO m = 1, surf_usm_v(l)%ns
3172	i = surf_usm_v(l)%i(m)
3173	j = surf_usm_v(l)%j(m)
3174	k = surf_usm_v(l)%k(m)
3175	temp_pf(k,j,i) = t_surf_green_v(l)%t(m)
3176	ENDDO
3177	ENDIF
3178
3179	ELSE
3180	IF ( idsint == iup_u ) THEN
3181	DO m = 1, surf_usm_h%ns
3182	i = surf_usm_h%i(m)
3183	j = surf_usm_h%j(m)
3184	k = surf_usm_h%k(m)
3185	temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
3186	ENDDO
3187	ELSE
3188	l = idsidx
3189	DO m = 1, surf_usm_v(l)%ns
3190	i = surf_usm_v(l)%i(m)
3191	j = surf_usm_v(l)%j(m)
3192	k = surf_usm_v(l)%k(m)
3193	temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
3194	ENDDO
3195
3196	ENDIF
3197
3198	ENDIF
3199
3200	CASE ( 'usm_t_surf_10cm' )
3201	!-- near surface temperature for whole surfaces
3202
3203	IF ( av == 0 ) THEN
3204	IF ( idsint == iup_u ) THEN
3205	DO m = 1, surf_usm_h%ns
3206	i = surf_usm_h%i(m)
3207	j = surf_usm_h%j(m)
3208	k = surf_usm_h%k(m)
3209	temp_pf(k,j,i) = t_surf_10cm_h(m)
3210	ENDDO
3211	ELSE
3212	l = idsidx
3213	DO m = 1, surf_usm_v(l)%ns
3214	i = surf_usm_v(l)%i(m)
3215	j = surf_usm_v(l)%j(m)
3216	k = surf_usm_v(l)%k(m)
3217	temp_pf(k,j,i) = t_surf_10cm_v(l)%t(m)
3218	ENDDO
3219	ENDIF
3220
3221	ELSE
3222	IF ( idsint == iup_u ) THEN
3223	DO m = 1, surf_usm_h%ns
3224	i = surf_usm_h%i(m)
3225	j = surf_usm_h%j(m)
3226	k = surf_usm_h%k(m)
3227	temp_pf(k,j,i) = surf_usm_h%t_surf_10cm_av(m)
3228	ENDDO
3229	ELSE
3230	l = idsidx
3231	DO m = 1, surf_usm_v(l)%ns
3232	i = surf_usm_v(l)%i(m)
3233	j = surf_usm_v(l)%j(m)
3234	k = surf_usm_v(l)%k(m)
3235	temp_pf(k,j,i) = surf_usm_v(l)%t_surf_10cm_av(m)
3236	ENDDO
3237
3238	ENDIF
3239
3240	ENDIF
3241
3242
3243	CASE ( 'usm_t_wall' )
3244	!-- wall temperature for iwl layer of walls and land
3245	IF ( av == 0 ) THEN
3246	IF ( idsint == iup_u ) THEN
3247	DO m = 1, surf_usm_h%ns
3248	i = surf_usm_h%i(m)
3249	j = surf_usm_h%j(m)
3250	k = surf_usm_h%k(m)
3251	temp_pf(k,j,i) = t_wall_h(iwl,m)
3252	ENDDO
3253	ELSE
3254	l = idsidx
3255	DO m = 1, surf_usm_v(l)%ns
3256	i = surf_usm_v(l)%i(m)
3257	j = surf_usm_v(l)%j(m)
3258	k = surf_usm_v(l)%k(m)
3259	temp_pf(k,j,i) = t_wall_v(l)%t(iwl,m)
3260	ENDDO
3261	ENDIF
3262	ELSE
3263	IF ( idsint == iup_u ) THEN
3264	DO m = 1, surf_usm_h%ns
3265	i = surf_usm_h%i(m)
3266	j = surf_usm_h%j(m)
3267	k = surf_usm_h%k(m)
3268	temp_pf(k,j,i) = surf_usm_h%t_wall_av(iwl,m)
3269	ENDDO
3270	ELSE
3271	l = idsidx
3272	DO m = 1, surf_usm_v(l)%ns
3273	i = surf_usm_v(l)%i(m)
3274	j = surf_usm_v(l)%j(m)
3275	k = surf_usm_v(l)%k(m)
3276	temp_pf(k,j,i) = surf_usm_v(l)%t_wall_av(iwl,m)
3277	ENDDO
3278	ENDIF
3279	ENDIF
3280
3281	CASE ( 'usm_t_window' )
3282	!-- window temperature for iwl layer of walls and land
3283	IF ( av == 0 ) THEN
3284	IF ( idsint == iup_u ) THEN
3285	DO m = 1, surf_usm_h%ns
3286	i = surf_usm_h%i(m)
3287	j = surf_usm_h%j(m)
3288	k = surf_usm_h%k(m)
3289	temp_pf(k,j,i) = t_window_h(iwl,m)
3290	ENDDO
3291	ELSE
3292	l = idsidx
3293	DO m = 1, surf_usm_v(l)%ns
3294	i = surf_usm_v(l)%i(m)
3295	j = surf_usm_v(l)%j(m)
3296	k = surf_usm_v(l)%k(m)
3297	temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
3298	ENDDO
3299	ENDIF
3300	ELSE
3301	IF ( idsint == iup_u ) THEN
3302	DO m = 1, surf_usm_h%ns
3303	i = surf_usm_h%i(m)
3304	j = surf_usm_h%j(m)
3305	k = surf_usm_h%k(m)
3306	temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
3307	ENDDO
3308	ELSE
3309	l = idsidx
3310	DO m = 1, surf_usm_v(l)%ns
3311	i = surf_usm_v(l)%i(m)
3312	j = surf_usm_v(l)%j(m)
3313	k = surf_usm_v(l)%k(m)
3314	temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
3315	ENDDO
3316	ENDIF
3317	ENDIF
3318
3319	CASE ( 'usm_t_green' )
3320	!-- green temperature for iwl layer of walls and land
3321	IF ( av == 0 ) THEN
3322	IF ( idsint == iup_u ) THEN
3323	DO m = 1, surf_usm_h%ns
3324	i = surf_usm_h%i(m)
3325	j = surf_usm_h%j(m)
3326	k = surf_usm_h%k(m)
3327	temp_pf(k,j,i) = t_green_h(iwl,m)
3328	ENDDO
3329	ELSE
3330	l = idsidx
3331	DO m = 1, surf_usm_v(l)%ns
3332	i = surf_usm_v(l)%i(m)
3333	j = surf_usm_v(l)%j(m)
3334	k = surf_usm_v(l)%k(m)
3335	temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
3336	ENDDO
3337	ENDIF
3338	ELSE
3339	IF ( idsint == iup_u ) THEN
3340	DO m = 1, surf_usm_h%ns
3341	i = surf_usm_h%i(m)
3342	j = surf_usm_h%j(m)
3343	k = surf_usm_h%k(m)
3344	temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
3345	ENDDO
3346	ELSE
3347	l = idsidx
3348	DO m = 1, surf_usm_v(l)%ns
3349	i = surf_usm_v(l)%i(m)
3350	j = surf_usm_v(l)%j(m)
3351	k = surf_usm_v(l)%k(m)
3352	temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
3353	ENDDO
3354	ENDIF
3355	ENDIF
3356
3357
3358	CASE DEFAULT
3359	found = .FALSE.
3360
3361	END SELECT
3362
3363	!
3364	!-- Rearrange dimensions for NetCDF output
3365	!-- FIXME: this may generate FPE overflow upon conversion from DP to SP
3366	DO j = nys, nyn
3367	DO i = nxl, nxr
3368	DO k = nzb_do, nzt_do
3369	local_pf(i,j,k) = temp_pf(k,j,i)
3370	ENDDO
3371	ENDDO
3372	ENDDO
3373
3374	END SUBROUTINE usm_data_output_3d
3375
3376
3377	!------------------------------------------------------------------------------!
3378	!
3379	! Description:
3380	! ------------
3381	!> Soubroutine defines appropriate grid for netcdf variables.
3382	!> It is called out from subroutine netcdf.
3383	!------------------------------------------------------------------------------!
3384	SUBROUTINE usm_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
3385
3386	IMPLICIT NONE
3387
3388	CHARACTER (len=*), INTENT(IN) :: variable !<
3389	LOGICAL, INTENT(OUT) :: found !<
3390	CHARACTER (len=*), INTENT(OUT) :: grid_x !<
3391	CHARACTER (len=*), INTENT(OUT) :: grid_y !<
3392	CHARACTER (len=*), INTENT(OUT) :: grid_z !<
3393
3394	CHARACTER (len=varnamelength) :: var
3395
3396	var = TRIM(variable)
3397	IF ( var(1:12) == 'usm_rad_net_' .OR. var(1:13) == 'usm_rad_insw_' .OR. &
3398	var(1:13) == 'usm_rad_inlw_' .OR. var(1:16) == 'usm_rad_inswdir_' .OR. &
3399	var(1:16) == 'usm_rad_inswdif_' .OR. var(1:16) == 'usm_rad_inswref_' .OR. &
3400	var(1:16) == 'usm_rad_inlwdif_' .OR. var(1:16) == 'usm_rad_inlwref_' .OR. &
3401	var(1:14) == 'usm_rad_outsw_' .OR. var(1:14) == 'usm_rad_outlw_' .OR. &
3402	var(1:14) == 'usm_rad_ressw_' .OR. var(1:14) == 'usm_rad_reslw_' .OR. &
3403	var(1:11) == 'usm_rad_hf_' .OR. &
3404	var(1:9) == 'usm_wshf_' .OR. var(1:9) == 'usm_wghf_' .OR. &
3405	var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR. &
3406	var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_' .OR. &
3407	var(1:10) == 'usm_t_surf' .OR. var(1:10) == 'usm_t_wall' .OR. &
3408	var(1:17) == 'usm_t_surf_window' .OR. var(1:12) == 'usm_t_window' .OR. &
3409	var(1:16) == 'usm_t_surf_green' .OR. &
3410	var(1:15) == 'usm_t_surf_10cm' .OR. &
3411	var(1:9) == 'usm_surfz' .OR. var(1:7) == 'usm_svf' .OR. &
3412	var(1:7) == 'usm_dif' .OR. var(1:11) == 'usm_surfcat' .OR. &
3413	var(1:11) == 'usm_surfalb' .OR. var(1:12) == 'usm_surfemis' .OR. &
3414	var(1:16) == 'usm_surfwintrans' .OR. &
3415	var(1:9) == 'usm_skyvf' .OR. var(1:9) == 'usm_skyvft' ) THEN
3416
3417	found = .TRUE.
3418	grid_x = 'x'
3419	grid_y = 'y'
3420	grid_z = 'zu'
3421	ELSE
3422	found = .FALSE.
3423	grid_x = 'none'
3424	grid_y = 'none'
3425	grid_z = 'none'
3426	ENDIF
3427
3428	END SUBROUTINE usm_define_netcdf_grid
3429
3430
3431	!------------------------------------------------------------------------------!
3432	! Description:
3433	! ------------
3434	!> Initialization of the wall surface model
3435	!------------------------------------------------------------------------------!
3436	SUBROUTINE usm_init_material_model
3437
3438	IMPLICIT NONE
3439
3440	INTEGER(iwp) :: k, l, m !< running indices
3441
3442	CALL location_message( ' initialization of wall surface model', .TRUE. )
3443
3444	!-- Calculate wall grid spacings.
3445	!-- Temperature is defined at the center of the wall layers,
3446	!-- whereas gradients/fluxes are defined at the edges (_stag)
3447	!-- apply for all particular surface grids. First for horizontal surfaces
3448	DO m = 1, surf_usm_h%ns
3449
3450	surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
3451	DO k = nzb_wall+1, nzt_wall
3452	surf_usm_h%dz_wall(k,m) = surf_usm_h%zw(k,m) - &
3453	surf_usm_h%zw(k-1,m)
3454	ENDDO
3455	surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
3456	DO k = nzb_wall+1, nzt_wall
3457	surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) - &
3458	surf_usm_h%zw_window(k-1,m)
3459	ENDDO
3460	surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
3461	DO k = nzb_wall+1, nzt_wall
3462	surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) - &
3463	surf_usm_h%zw_green(k-1,m)
3464	ENDDO
3465
3466	surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
3467
3468	DO k = nzb_wall, nzt_wall-1
3469	surf_usm_h%dz_wall_stag(k,m) = 0.5 * ( &
3470	surf_usm_h%dz_wall(k+1,m) + surf_usm_h%dz_wall(k,m) )
3471	ENDDO
3472	surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
3473
3474	surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
3475
3476	DO k = nzb_wall, nzt_wall-1
3477	surf_usm_h%dz_window_stag(k,m) = 0.5 * ( &
3478	surf_usm_h%dz_window(k+1,m) + surf_usm_h%dz_window(k,m) )
3479	ENDDO
3480	surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
3481
3482	surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
3483
3484	DO k = nzb_wall, nzt_wall-1
3485	surf_usm_h%dz_green_stag(k,m) = 0.5 * ( &
3486	surf_usm_h%dz_green(k+1,m) + surf_usm_h%dz_green(k,m) )
3487	ENDDO
3488	surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
3489	ENDDO
3490	surf_usm_h%ddz_wall = 1.0_wp / surf_usm_h%dz_wall
3491	surf_usm_h%ddz_wall_stag = 1.0_wp / surf_usm_h%dz_wall_stag
3492	surf_usm_h%ddz_window = 1.0_wp / surf_usm_h%dz_window
3493	surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
3494	surf_usm_h%ddz_green = 1.0_wp / surf_usm_h%dz_green
3495	surf_usm_h%ddz_green_stag = 1.0_wp / surf_usm_h%dz_green_stag
3496	!
3497	!-- For vertical surfaces
3498	DO l = 0, 3
3499	DO m = 1, surf_usm_v(l)%ns
3500	surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
3501	DO k = nzb_wall+1, nzt_wall
3502	surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) - &
3503	surf_usm_v(l)%zw(k-1,m)
3504	ENDDO
3505	surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
3506	DO k = nzb_wall+1, nzt_wall
3507	surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) - &
3508	surf_usm_v(l)%zw_window(k-1,m)
3509	ENDDO
3510	surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
3511	DO k = nzb_wall+1, nzt_wall
3512	surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) - &
3513	surf_usm_v(l)%zw_green(k-1,m)
3514	ENDDO
3515
3516	surf_usm_v(l)%dz_wall(nzt_wall+1,m) = &
3517	surf_usm_v(l)%dz_wall(nzt_wall,m)
3518
3519	DO k = nzb_wall, nzt_wall-1
3520	surf_usm_v(l)%dz_wall_stag(k,m) = 0.5 * ( &
3521	surf_usm_v(l)%dz_wall(k+1,m) + &
3522	surf_usm_v(l)%dz_wall(k,m) )
3523	ENDDO
3524	surf_usm_v(l)%dz_wall_stag(nzt_wall,m) = &
3525	surf_usm_v(l)%dz_wall(nzt_wall,m)
3526	surf_usm_v(l)%dz_window(nzt_wall+1,m) = &
3527	surf_usm_v(l)%dz_window(nzt_wall,m)
3528
3529	DO k = nzb_wall, nzt_wall-1
3530	surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * ( &
3531	surf_usm_v(l)%dz_window(k+1,m) + &
3532	surf_usm_v(l)%dz_window(k,m) )
3533	ENDDO
3534	surf_usm_v(l)%dz_window_stag(nzt_wall,m) = &
3535	surf_usm_v(l)%dz_window(nzt_wall,m)
3536	surf_usm_v(l)%dz_green(nzt_wall+1,m) = &
3537	surf_usm_v(l)%dz_green(nzt_wall,m)
3538
3539	DO k = nzb_wall, nzt_wall-1
3540	surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * ( &
3541	surf_usm_v(l)%dz_green(k+1,m) + &
3542	surf_usm_v(l)%dz_green(k,m) )
3543	ENDDO
3544	surf_usm_v(l)%dz_green_stag(nzt_wall,m) = &
3545	surf_usm_v(l)%dz_green(nzt_wall,m)
3546	ENDDO
3547	surf_usm_v(l)%ddz_wall = 1.0_wp / surf_usm_v(l)%dz_wall
3548	surf_usm_v(l)%ddz_wall_stag = 1.0_wp / surf_usm_v(l)%dz_wall_stag
3549	surf_usm_v(l)%ddz_window = 1.0_wp / surf_usm_v(l)%dz_window
3550	surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
3551	surf_usm_v(l)%ddz_green = 1.0_wp / surf_usm_v(l)%dz_green
3552	surf_usm_v(l)%ddz_green_stag = 1.0_wp / surf_usm_v(l)%dz_green_stag
3553	ENDDO
3554
3555
3556	CALL location_message( ' wall structures filed out', .TRUE. )
3557
3558	CALL location_message( ' initialization of wall surface model finished', .TRUE. )
3559
3560	END SUBROUTINE usm_init_material_model
3561
3562
3563	!------------------------------------------------------------------------------!
3564	! Description:
3565	! ------------
3566	!> Initialization of the urban surface model
3567	!------------------------------------------------------------------------------!
3568	SUBROUTINE usm_init_urban_surface
3569
3570	USE arrays_3d, &
3571	ONLY: zw
3572
3573	USE netcdf_data_input_mod, &
3574	ONLY: building_pars_f, building_type_f, terrain_height_f
3575
3576	IMPLICIT NONE
3577
3578	INTEGER(iwp) :: i !< loop index x-dirction
3579	INTEGER(iwp) :: ind_emis_wall !< index in input list for wall emissivity
3580	INTEGER(iwp) :: ind_emis_green !< index in input list for green emissivity
3581	INTEGER(iwp) :: ind_emis_win !< index in input list for window emissivity
3582	INTEGER(iwp) :: ind_green_frac_w !< index in input list for green fraction on wall
3583	INTEGER(iwp) :: ind_green_frac_r !< index in input list for green fraction on roof
3584	INTEGER(iwp) :: ind_hc1 !< index in input list for heat capacity at first wall layer
3585	INTEGER(iwp) :: ind_hc2 !< index in input list for heat capacity at second wall layer
3586	INTEGER(iwp) :: ind_hc3 !< index in input list for heat capacity at third wall layer
3587	INTEGER(iwp) :: ind_lai_r !< index in input list for LAI on roof
3588	INTEGER(iwp) :: ind_lai_w !< index in input list for LAI on wall
3589	INTEGER(iwp) :: ind_tc1 !< index in input list for thermal conductivity at first wall layer
3590	INTEGER(iwp) :: ind_tc2 !< index in input list for thermal conductivity at second wall layer
3591	INTEGER(iwp) :: ind_tc3 !< index in input list for thermal conductivity at third wall layer
3592	INTEGER(iwp) :: ind_trans !< index in input list for window transmissivity
3593	INTEGER(iwp) :: ind_wall_frac !< index in input list for wall fraction
3594	INTEGER(iwp) :: ind_win_frac !< index in input list for window fraction
3595	INTEGER(iwp) :: ind_z0 !< index in input list for z0
3596	INTEGER(iwp) :: ind_z0qh !< index in input list for z0h / z0q
3597	INTEGER(iwp) :: j !< loop index y-dirction
3598	INTEGER(iwp) :: k !< loop index z-dirction
3599	INTEGER(iwp) :: l !< loop index surface orientation
3600	INTEGER(iwp) :: m !< loop index surface element
3601	INTEGER(iwp) :: st !< dummy
3602
3603	REAL(wp) :: c, d, tin, twin
3604	REAL(wp) :: ground_floor_level_l !< local height of ground floor level
3605	REAL(wp) :: z_agl !< height above ground
3606	REAL(wp), DIMENSION(nzb:nzt) :: exn !< value of the Exner function in layers
3607
3608	!
3609	!-- NOPOINTER version not implemented yet
3610	#if defined( __nopointer )
3611	message_string = 'The urban surface module only runs with POINTER version'
3612	CALL message( 'urban_surface_mod', 'PA0452', 1, 2, 0, 6, 0 )
3613	#endif
3614
3615	CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
3616	!-- surface forcing have to be disabled for LSF
3617	!-- in case of enabled urban surface module
3618	IF ( large_scale_forcing ) THEN
3619	lsf_surf = .FALSE.
3620	ENDIF
3621
3622	!
3623	!-- Flag surface elements belonging to the ground floor level. Therefore,
3624	!-- use terrain height array from file, if available. This flag is later used
3625	!-- to control initialization of surface attributes.
3626	surf_usm_h%ground_level = .FALSE.
3627	DO m = 1, surf_usm_h%ns
3628	i = surf_usm_h%i(m)
3629	j = surf_usm_h%j(m)
3630	k = surf_usm_h%k(m)
3631	!
3632	!-- Get local ground level. If no ground level is given in input file,
3633	!-- use default value.
3634	ground_floor_level_l = ground_floor_level
3635	IF ( building_pars_f%from_file ) THEN
3636	IF ( building_pars_f%pars_xy(ind_gflh,j,i) /= &
3637	building_pars_f%fill ) &
3638	ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
3639	ENDIF
3640	!
3641	!-- Determine height of surface element above ground level
3642	IF ( terrain_height_f%from_file ) THEN
3643	z_agl = zw(k) - terrain_height_f%var(j,i)
3644	ELSE
3645	z_agl = zw(k)
3646	ENDIF
3647	!
3648	!-- Set flag for ground level
3649	IF ( z_agl <= ground_floor_level_l ) &
3650	surf_usm_h%ground_level(m) = .TRUE.
3651	ENDDO
3652
3653	DO l = 0, 3
3654	surf_usm_v(l)%ground_level = .FALSE.
3655	DO m = 1, surf_usm_v(l)%ns
3656	i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
3657	j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
3658	k = surf_usm_v(l)%k(m)
3659	!
3660	!-- Get local ground level. If no ground level is given in input file,
3661	!-- use default value.
3662	ground_floor_level_l = ground_floor_level
3663	IF ( building_pars_f%from_file ) THEN
3664	IF ( building_pars_f%pars_xy(ind_gflh,j,i) /= &
3665	building_pars_f%fill ) &
3666	ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
3667	ENDIF
3668	!
3669	!-- Determine height of surface element above ground level. Please
3670	!-- note, height of surface element is determined with respect to
3671	!-- its height of the adjoing atmospheric grid point.
3672	IF ( terrain_height_f%from_file ) THEN
3673	z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff, &
3674	i-surf_usm_v(l)%ioff)
3675	ELSE
3676	z_agl = zw(k)
3677	ENDIF
3678	!
3679	!-- Set flag for ground level
3680	IF ( z_agl <= ground_floor_level_l ) &
3681	surf_usm_v(l)%ground_level(m) = .TRUE.
3682
3683	ENDDO
3684	ENDDO
3685	!
3686	!-- Initialization of resistances.
3687	DO m = 1, surf_usm_h%ns
3688	surf_usm_h%r_a(m) = 50.0_wp
3689	surf_usm_h%r_a_green(m) = 50.0_wp
3690	surf_usm_h%r_a_window(m) = 50.0_wp
3691	ENDDO
3692	DO l = 0, 3
3693	DO m = 1, surf_usm_v(l)%ns
3694	surf_usm_v(l)%r_a(m) = 50.0_wp
3695	surf_usm_v(l)%r_a_green(m) = 50.0_wp
3696	surf_usm_v(l)%r_a_window(m) = 50.0_wp
3697	ENDDO
3698	ENDDO
3699	!
3700	!-- Initialize urban-type surface attribute. According to initialization in
3701	!-- land-surface model, follow a 3-level approach.
3702	!-- Level 1 - initialization via default attributes
3703	DO m = 1, surf_usm_h%ns
3704	!
3705	!-- Now, all horizontal surfaces are roof surfaces (?)
3706	surf_usm_h%isroof_surf(m) = .TRUE.
3707	surf_usm_h%surface_types(m) = roof_category !< default category for root surface
3708	!
3709	!-- In order to distinguish between ground floor level and
3710	!-- above-ground-floor level surfaces, set input indices.
3711	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
3712	surf_usm_h%ground_level(m) )
3713	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
3714	surf_usm_h%ground_level(m) )
3715	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
3716	surf_usm_h%ground_level(m) )
3717	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3718	surf_usm_h%ground_level(m) )
3719	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
3720	surf_usm_h%ground_level(m) )
3721	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
3722	surf_usm_h%ground_level(m) )
3723	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
3724	surf_usm_h%ground_level(m) )
3725	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
3726	surf_usm_h%ground_level(m) )
3727	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
3728	surf_usm_h%ground_level(m) )
3729	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
3730	surf_usm_h%ground_level(m) )
3731	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
3732	surf_usm_h%ground_level(m) )
3733	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
3734	surf_usm_h%ground_level(m) )
3735	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
3736	surf_usm_h%ground_level(m) )
3737	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
3738	surf_usm_h%ground_level(m) )
3739	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
3740	surf_usm_h%ground_level(m) )
3741	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
3742	surf_usm_h%ground_level(m) )
3743	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
3744	surf_usm_h%ground_level(m) )
3745	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
3746	surf_usm_h%ground_level(m) )
3747	!
3748	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
3749	surf_usm_h%frac(ind_veg_wall,m) = building_pars(ind_wall_frac,building_type)
3750	surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,building_type)
3751	surf_usm_h%frac(ind_wat_win,m) = building_pars(ind_win_frac,building_type)
3752	surf_usm_h%lai(m) = building_pars(ind_green_frac_r,building_type)
3753
3754	surf_usm_h%rho_c_wall(nzb_wall,m) = building_pars(ind_hc1,building_type)
3755	surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3756	surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3757	surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3758	surf_usm_h%lambda_h(nzb_wall,m) = building_pars(ind_tc1,building_type)
3759	surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3760	surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3761	surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3762	surf_usm_h%rho_c_green(nzb_wall,m) = building_pars(ind_hc1,building_type)
3763	surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3764	surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3765	surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3766	surf_usm_h%lambda_h_green(nzb_wall,m) = building_pars(ind_tc1,building_type)
3767	surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3768	surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3769	surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3770	surf_usm_h%rho_c_window(nzb_wall,m) = building_pars(ind_hc1,building_type)
3771	surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3772	surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3773	surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3774	surf_usm_h%lambda_h_window(nzb_wall,m) = building_pars(ind_tc1,building_type)
3775	surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3776	surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3777	surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3778
3779	surf_usm_h%target_temp_summer(m) = building_pars(12,building_type)
3780	surf_usm_h%target_temp_winter(m) = building_pars(13,building_type)
3781	!
3782	!-- emissivity of wall-, green- and window fraction
3783	surf_usm_h%emissivity(ind_veg_wall,m) = building_pars(ind_emis_wall,building_type)
3784	surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,building_type)
3785	surf_usm_h%emissivity(ind_wat_win,m) = building_pars(ind_emis_win,building_type)
3786
3787	surf_usm_h%transmissivity(m) = building_pars(ind_trans,building_type)
3788
3789	surf_usm_h%z0(m) = building_pars(ind_z0,building_type)
3790	surf_usm_h%z0h(m) = building_pars(ind_z0qh,building_type)
3791	surf_usm_h%z0q(m) = building_pars(ind_z0qh,building_type)
3792	!
3793	!-- albedo type for wall fraction, green fraction, window fraction
3794	surf_usm_h%albedo_type(ind_veg_wall,m) = INT( building_pars(ind_alb_wall,building_type) )
3795	surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,building_type) )
3796	surf_usm_h%albedo_type(ind_wat_win,m) = INT( building_pars(ind_alb_win,building_type) )
3797
3798	surf_usm_h%zw(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3799	surf_usm_h%zw(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3800	surf_usm_h%zw(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3801	surf_usm_h%zw(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3802
3803	surf_usm_h%zw_green(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3804	surf_usm_h%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3805	surf_usm_h%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3806	surf_usm_h%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3807
3808	surf_usm_h%zw_window(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3809	surf_usm_h%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3810	surf_usm_h%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3811	surf_usm_h%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3812
3813	surf_usm_h%c_surface(m) = building_pars(45,building_type)
3814	surf_usm_h%lambda_surf(m) = building_pars(46,building_type)
3815	surf_usm_h%c_surface_green(m) = building_pars(45,building_type)
3816	surf_usm_h%lambda_surf_green(m) = building_pars(46,building_type)
3817	surf_usm_h%c_surface_window(m) = building_pars(45,building_type)
3818	surf_usm_h%lambda_surf_window(m) = building_pars(46,building_type)
3819
3820	ENDDO
3821
3822	DO l = 0, 3
3823	DO m = 1, surf_usm_v(l)%ns
3824
3825	surf_usm_v(l)%surface_types(m) = wall_category !< default category for root surface
3826	!
3827	!-- In order to distinguish between ground floor level and
3828	!-- above-ground-floor level surfaces, set input indices.
3829	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
3830	surf_usm_v(l)%ground_level(m) )
3831	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
3832	surf_usm_v(l)%ground_level(m) )
3833	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
3834	surf_usm_v(l)%ground_level(m) )
3835	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3836	surf_usm_v(l)%ground_level(m) )
3837	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
3838	surf_usm_v(l)%ground_level(m) )
3839	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
3840	surf_usm_v(l)%ground_level(m) )
3841	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
3842	surf_usm_v(l)%ground_level(m) )
3843	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
3844	surf_usm_v(l)%ground_level(m) )
3845	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
3846	surf_usm_v(l)%ground_level(m) )
3847	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
3848	surf_usm_v(l)%ground_level(m) )
3849	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
3850	surf_usm_v(l)%ground_level(m) )
3851	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
3852	surf_usm_v(l)%ground_level(m) )
3853	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
3854	surf_usm_v(l)%ground_level(m) )
3855	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
3856	surf_usm_v(l)%ground_level(m) )
3857	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
3858	surf_usm_v(l)%ground_level(m) )
3859	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
3860	surf_usm_v(l)%ground_level(m) )
3861	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
3862	surf_usm_v(l)%ground_level(m) )
3863	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
3864	surf_usm_v(l)%ground_level(m) )
3865
3866	!
3867	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
3868	surf_usm_v(l)%frac(ind_veg_wall,m) = building_pars(ind_wall_frac,building_type)
3869	surf_usm_v(l)%frac(ind_pav_green,m) = building_pars(ind_green_frac_w,building_type)
3870	surf_usm_v(l)%frac(ind_wat_win,m) = building_pars(ind_win_frac,building_type)
3871	surf_usm_v(l)%lai(m) = building_pars(ind_lai_w,building_type)
3872
3873	surf_usm_v(l)%rho_c_wall(nzb_wall,m) = building_pars(ind_hc1,building_type)
3874	surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3875	surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3876	surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3877
3878	surf_usm_v(l)%rho_c_green(nzb_wall,m) = building_pars(ind_hc1,building_type)
3879	surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3880	surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3881	surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3882
3883	surf_usm_v(l)%rho_c_window(nzb_wall,m) = building_pars(ind_hc1,building_type)
3884	surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
3885	surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
3886	surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,building_type)
3887
3888	surf_usm_v(l)%lambda_h(nzb_wall,m) = building_pars(ind_tc1,building_type)
3889	surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3890	surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3891	surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3892
3893	surf_usm_v(l)%lambda_h_green(nzb_wall,m) = building_pars(ind_tc1,building_type)
3894	surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3895	surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3896	surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3897
3898	surf_usm_v(l)%lambda_h_window(nzb_wall,m) = building_pars(ind_tc1,building_type)
3899	surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
3900	surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
3901	surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
3902
3903	surf_usm_v(l)%target_temp_summer(m) = building_pars(12,building_type)
3904	surf_usm_v(l)%target_temp_winter(m) = building_pars(13,building_type)
3905	!
3906	!-- emissivity of wall-, green- and window fraction
3907	surf_usm_v(l)%emissivity(ind_veg_wall,m) = building_pars(ind_emis_wall,building_type)
3908	surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,building_type)
3909	surf_usm_v(l)%emissivity(ind_wat_win,m) = building_pars(ind_emis_win,building_type)
3910
3911	surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,building_type)
3912
3913	surf_usm_v(l)%z0(m) = building_pars(ind_z0,building_type)
3914	surf_usm_v(l)%z0h(m) = building_pars(ind_z0qh,building_type)
3915	surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,building_type)
3916
3917	surf_usm_v(l)%albedo_type(ind_veg_wall,m) = INT( building_pars(ind_alb_wall,building_type) )
3918	surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,building_type) )
3919	surf_usm_v(l)%albedo_type(ind_wat_win,m) = INT( building_pars(ind_alb_win,building_type) )
3920
3921	surf_usm_v(l)%zw(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3922	surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3923	surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3924	surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3925
3926	surf_usm_v(l)%zw_green(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3927	surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3928	surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3929	surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3930
3931	surf_usm_v(l)%zw_window(nzb_wall,m) = building_pars(ind_thick_1,building_type)
3932	surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2,building_type)
3933	surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3,building_type)
3934	surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4,building_type)
3935
3936	surf_usm_v(l)%c_surface(m) = building_pars(45,building_type)
3937	surf_usm_v(l)%lambda_surf(m) = building_pars(46,building_type)
3938	surf_usm_v(l)%c_surface_green(m) = building_pars(45,building_type)
3939	surf_usm_v(l)%lambda_surf_green(m) = building_pars(46,building_type)
3940	surf_usm_v(l)%c_surface_window(m) = building_pars(45,building_type)
3941	surf_usm_v(l)%lambda_surf_window(m) = building_pars(46,building_type)
3942
3943	ENDDO
3944	ENDDO
3945	!
3946	!-- Level 2 - initialization via building type read from file
3947	IF ( building_type_f%from_file ) THEN
3948	DO m = 1, surf_usm_h%ns
3949	i = surf_usm_h%i(m)
3950	j = surf_usm_h%j(m)
3951	!
3952	!-- For the moment, limit building type to 6 (to overcome errors in input file).
3953	st = building_type_f%var(j,i)
3954	IF ( st /= building_type_f%fill ) THEN
3955
3956	!
3957	!-- In order to distinguish between ground floor level and
3958	!-- above-ground-floor level surfaces, set input indices.
3959	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
3960	surf_usm_h%ground_level(m) )
3961	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
3962	surf_usm_h%ground_level(m) )
3963	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
3964	surf_usm_h%ground_level(m) )
3965	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
3966	surf_usm_h%ground_level(m) )
3967	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
3968	surf_usm_h%ground_level(m) )
3969	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
3970	surf_usm_h%ground_level(m) )
3971	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
3972	surf_usm_h%ground_level(m) )
3973	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
3974	surf_usm_h%ground_level(m) )
3975	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
3976	surf_usm_h%ground_level(m) )
3977	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
3978	surf_usm_h%ground_level(m) )
3979	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
3980	surf_usm_h%ground_level(m) )
3981	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
3982	surf_usm_h%ground_level(m) )
3983	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
3984	surf_usm_h%ground_level(m) )
3985	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
3986	surf_usm_h%ground_level(m) )
3987	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
3988	surf_usm_h%ground_level(m) )
3989	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
3990	surf_usm_h%ground_level(m) )
3991	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
3992	surf_usm_h%ground_level(m) )
3993	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
3994	surf_usm_h%ground_level(m) )
3995
3996	!
3997	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
3998	surf_usm_h%frac(ind_veg_wall,m) = building_pars(ind_wall_frac,st)
3999	surf_usm_h%frac(ind_pav_green,m) = building_pars(ind_green_frac_r,st)
4000	surf_usm_h%frac(ind_wat_win,m) = building_pars(ind_win_frac,st)
4001	surf_usm_h%lai(m) = building_pars(ind_green_frac_r,st)
4002
4003	surf_usm_h%rho_c_wall(nzb_wall,m) = building_pars(ind_hc1,st)
4004	surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
4005	surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
4006	surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
4007	surf_usm_h%lambda_h(nzb_wall,m) = building_pars(ind_tc1,st)
4008	surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st)
4009	surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
4010	surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)
4011
4012	surf_usm_h%rho_c_green(nzb_wall,m) = building_pars(ind_hc1,st)
4013	surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
4014	surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
4015	surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)
4016	surf_usm_h%lambda_h_green(nzb_wall,m) = building_pars(ind_tc1,st)
4017	surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st)
4018	surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
4019	surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st)
4020
4021	surf_usm_h%rho_c_window(nzb_wall,m) = building_pars(ind_hc1,st)
4022	surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
4023	surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
4024	surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,st)
4025	surf_usm_h%lambda_h_window(nzb_wall,m) = building_pars(ind_tc1,st)
4026	surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st)
4027	surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
4028	surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st)
4029
4030	surf_usm_h%target_temp_summer(m) = building_pars(12,st)
4031	surf_usm_h%target_temp_winter(m) = building_pars(13,st)
4032	!
4033	!-- emissivity of wall-, green- and window fraction
4034	surf_usm_h%emissivity(ind_veg_wall,m) = building_pars(ind_emis_wall,st)
4035	surf_usm_h%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,st)
4036	surf_usm_h%emissivity(ind_wat_win,m) = building_pars(ind_emis_win,st)
4037
4038	surf_usm_h%transmissivity(m) = building_pars(ind_trans,st)
4039
4040	surf_usm_h%z0(m) = building_pars(ind_z0,st)
4041	surf_usm_h%z0h(m) = building_pars(ind_z0qh,st)
4042	surf_usm_h%z0q(m) = building_pars(ind_z0qh,st)
4043	!
4044	!-- albedo type for wall fraction, green fraction, window fraction
4045	surf_usm_h%albedo_type(ind_veg_wall,m) = INT( building_pars(ind_alb_wall,st) )
4046	surf_usm_h%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,st) )
4047	surf_usm_h%albedo_type(ind_wat_win,m) = INT( building_pars(ind_alb_win,st) )
4048
4049	surf_usm_h%zw(nzb_wall,m) = building_pars(ind_thick_1,st)
4050	surf_usm_h%zw(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4051	surf_usm_h%zw(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4052	surf_usm_h%zw(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4053
4054	surf_usm_h%zw_green(nzb_wall,m) = building_pars(ind_thick_1,st)
4055	surf_usm_h%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4056	surf_usm_h%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4057	surf_usm_h%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4058
4059	surf_usm_h%zw_window(nzb_wall,m) = building_pars(ind_thick_1,st)
4060	surf_usm_h%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4061	surf_usm_h%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4062	surf_usm_h%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4063
4064	surf_usm_h%c_surface(m) = building_pars(45,st)
4065	surf_usm_h%lambda_surf(m) = building_pars(46,st)
4066	surf_usm_h%c_surface_green(m) = building_pars(45,st)
4067	surf_usm_h%lambda_surf_green(m) = building_pars(46,st)
4068	surf_usm_h%c_surface_window(m) = building_pars(45,st)
4069	surf_usm_h%lambda_surf_window(m) = building_pars(46,st)
4070
4071	ENDIF
4072	ENDDO
4073
4074	DO l = 0, 3
4075	DO m = 1, surf_usm_v(l)%ns
4076	i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4077	j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4078	!
4079	!-- For the moment, limit building type to 6 (to overcome errors in input file).
4080
4081	st = building_type_f%var(j,i)
4082	IF ( st /= building_type_f%fill ) THEN
4083
4084	!
4085	!-- In order to distinguish between ground floor level and
4086	!-- above-ground-floor level surfaces, set input indices.
4087	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
4088	surf_usm_v(l)%ground_level(m) )
4089	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
4090	surf_usm_v(l)%ground_level(m) )
4091	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
4092	surf_usm_v(l)%ground_level(m) )
4093	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4094	surf_usm_v(l)%ground_level(m) )
4095	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
4096	surf_usm_v(l)%ground_level(m) )
4097	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
4098	surf_usm_v(l)%ground_level(m) )
4099	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
4100	surf_usm_v(l)%ground_level(m) )
4101	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
4102	surf_usm_v(l)%ground_level(m) )
4103	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
4104	surf_usm_v(l)%ground_level(m) )
4105	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
4106	surf_usm_v(l)%ground_level(m) )
4107	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
4108	surf_usm_v(l)%ground_level(m) )
4109	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
4110	surf_usm_v(l)%ground_level(m) )
4111	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
4112	surf_usm_v(l)%ground_level(m) )
4113	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
4114	surf_usm_v(l)%ground_level(m) )
4115	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
4116	surf_usm_v(l)%ground_level(m) )
4117	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
4118	surf_usm_v(l)%ground_level(m) )
4119	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
4120	surf_usm_v(l)%ground_level(m) )
4121	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
4122	surf_usm_v(l)%ground_level(m) )
4123
4124	!
4125	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
4126	surf_usm_v(l)%frac(ind_veg_wall,m) = building_pars(ind_wall_frac,st)
4127	surf_usm_v(l)%frac(ind_pav_green,m) = building_pars(ind_green_frac_w,st)
4128	surf_usm_v(l)%frac(ind_wat_win,m) = building_pars(ind_win_frac,st)
4129	surf_usm_v(l)%lai(m) = building_pars(ind_lai_w,st)
4130
4131	surf_usm_v(l)%rho_c_wall(nzb_wall,m) = building_pars(ind_hc1,st)
4132	surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
4133	surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
4134	surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
4135
4136	surf_usm_v(l)%rho_c_green(nzb_wall,m) = building_pars(ind_hc1,st)
4137	surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
4138	surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
4139	surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)
4140
4141	surf_usm_v(l)%rho_c_window(nzb_wall,m) = building_pars(ind_hc1,st)
4142	surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
4143	surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
4144	surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,st)
4145
4146	surf_usm_v(l)%lambda_h(nzb_wall,m) = building_pars(ind_tc1,st)
4147	surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st)
4148	surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
4149	surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)
4150
4151	surf_usm_v(l)%lambda_h_green(nzb_wall,m) = building_pars(ind_tc1,st)
4152	surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st)
4153	surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
4154	surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st)
4155
4156	surf_usm_v(l)%lambda_h_window(nzb_wall,m) = building_pars(ind_tc1,st)
4157	surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st)
4158	surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
4159	surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st)
4160
4161	surf_usm_v(l)%target_temp_summer(m) = building_pars(12,st)
4162	surf_usm_v(l)%target_temp_winter(m) = building_pars(13,st)
4163	!
4164	!-- emissivity of wall-, green- and window fraction
4165	surf_usm_v(l)%emissivity(ind_veg_wall,m) = building_pars(ind_emis_wall,st)
4166	surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars(ind_emis_green,st)
4167	surf_usm_v(l)%emissivity(ind_wat_win,m) = building_pars(ind_emis_win,st)
4168
4169	surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,st)
4170
4171	surf_usm_v(l)%z0(m) = building_pars(ind_z0,st)
4172	surf_usm_v(l)%z0h(m) = building_pars(ind_z0qh,st)
4173	surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,st)
4174
4175	surf_usm_v(l)%albedo_type(ind_veg_wall,m) = INT( building_pars(ind_alb_wall,st) )
4176	surf_usm_v(l)%albedo_type(ind_pav_green,m) = INT( building_pars(ind_alb_green,st) )
4177	surf_usm_v(l)%albedo_type(ind_wat_win,m) = INT( building_pars(ind_alb_win,st) )
4178
4179	surf_usm_v(l)%zw(nzb_wall,m) = building_pars(ind_thick_1,st)
4180	surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4181	surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4182	surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4183
4184	surf_usm_v(l)%zw_green(nzb_wall,m) = building_pars(ind_thick_1,st)
4185	surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4186	surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4187	surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4188
4189	surf_usm_v(l)%zw_window(nzb_wall,m) = building_pars(ind_thick_1,st)
4190	surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars(ind_thick_2,st)
4191	surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars(ind_thick_3,st)
4192	surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars(ind_thick_4,st)
4193
4194	surf_usm_v(l)%c_surface(m) = building_pars(45,st)
4195	surf_usm_v(l)%lambda_surf(m) = building_pars(46,st)
4196	surf_usm_v(l)%c_surface_green(m) = building_pars(45,st)
4197	surf_usm_v(l)%lambda_surf_green(m) = building_pars(46,st)
4198	surf_usm_v(l)%c_surface_window(m) = building_pars(45,st)
4199	surf_usm_v(l)%lambda_surf_window(m) = building_pars(46,st)
4200
4201
4202	ENDIF
4203	ENDDO
4204	ENDDO
4205	ENDIF
4206
4207	!
4208	!-- Level 3 - initialization via building_pars read from file
4209	IF ( building_pars_f%from_file ) THEN
4210	DO m = 1, surf_usm_h%ns
4211	i = surf_usm_h%i(m)
4212	j = surf_usm_h%j(m)
4213
4214	!
4215	!-- In order to distinguish between ground floor level and
4216	!-- above-ground-floor level surfaces, set input indices.
4217	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
4218	surf_usm_h%ground_level(m) )
4219	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
4220	surf_usm_h%ground_level(m) )
4221	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
4222	surf_usm_h%ground_level(m) )
4223	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4224	surf_usm_h%ground_level(m) )
4225	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
4226	surf_usm_h%ground_level(m) )
4227	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
4228	surf_usm_h%ground_level(m) )
4229	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
4230	surf_usm_h%ground_level(m) )
4231	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
4232	surf_usm_h%ground_level(m) )
4233	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
4234	surf_usm_h%ground_level(m) )
4235	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
4236	surf_usm_h%ground_level(m) )
4237	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
4238	surf_usm_h%ground_level(m) )
4239	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
4240	surf_usm_h%ground_level(m) )
4241	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
4242	surf_usm_h%ground_level(m) )
4243	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
4244	surf_usm_h%ground_level(m) )
4245	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
4246	surf_usm_h%ground_level(m) )
4247	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
4248	surf_usm_h%ground_level(m) )
4249	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
4250	surf_usm_h%ground_level(m) )
4251	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
4252	surf_usm_h%ground_level(m) )
4253
4254	!
4255	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
4256	IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill ) &
4257	surf_usm_h%frac(ind_veg_wall,m) = building_pars_f%pars_xy(ind_wall_frac,j,i)
4258	IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /= building_pars_f%fill ) &
4259	surf_usm_h%frac(ind_pav_green,m) = building_pars_f%pars_xy(ind_green_frac_r,j,i)
4260	IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill ) &
4261	surf_usm_h%frac(ind_wat_win,m) = building_pars_f%pars_xy(ind_win_frac,j,i)
4262
4263
4264	IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /= building_pars_f%fill ) &
4265	surf_usm_h%lai(m) = building_pars_f%pars_xy(ind_lai_r,j,i)
4266
4267	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) THEN
4268	surf_usm_h%rho_c_wall(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4269	surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4270	ENDIF
4271	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4272	surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4273	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4274	surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4275	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) THEN
4276	surf_usm_h%rho_c_green(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4277	surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4278	ENDIF
4279	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4280	surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4281	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4282	surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4283	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) THEN
4284	surf_usm_h%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4285	surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4286	ENDIF
4287	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4288	surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4289	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4290	surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4291
4292	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4293	surf_usm_h%lambda_h(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4294	surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4295	ENDIF
4296	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4297	surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4298	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4299	surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4300	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4301	surf_usm_h%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4302	surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4303	ENDIF
4304	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4305	surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4306	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4307	surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4308	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4309	surf_usm_h%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4310	surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4311	ENDIF
4312	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4313	surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4314	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4315	surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4316
4317	IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill ) &
4318	surf_usm_h%target_temp_summer(m) = building_pars_f%pars_xy(12,j,i)
4319	IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill ) &
4320	surf_usm_h%target_temp_winter(m) = building_pars_f%pars_xy(13,j,i)
4321
4322	IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) &
4323	surf_usm_h%emissivity(ind_veg_wall,m) = building_pars_f%pars_xy(ind_emis_wall,j,i)
4324	IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )&
4325	surf_usm_h%emissivity(ind_pav_green,m) = building_pars_f%pars_xy(ind_emis_green,j,i)
4326	IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill ) &
4327	surf_usm_h%emissivity(ind_wat_win,m) = building_pars_f%pars_xy(ind_emis_win,j,i)
4328
4329	IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill ) &
4330	surf_usm_h%transmissivity(m) = building_pars_f%pars_xy(ind_trans,j,i)
4331
4332	IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill ) &
4333	surf_usm_h%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4334	IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill ) &
4335	surf_usm_h%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4336	IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill ) &
4337	surf_usm_h%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4338
4339	IF ( building_pars_f%pars_xy(ind_alb_wall,j,i) /= building_pars_f%fill ) &
4340	surf_usm_h%albedo_type(ind_veg_wall,m) = building_pars_f%pars_xy(ind_alb_wall,j,i)
4341	IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill ) &
4342	surf_usm_h%albedo_type(ind_pav_green,m) = building_pars_f%pars_xy(ind_alb_green,j,i)
4343	IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill ) &
4344	surf_usm_h%albedo_type(ind_wat_win,m) = building_pars_f%pars_xy(ind_alb_win,j,i)
4345
4346	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4347	surf_usm_h%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4348	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4349	surf_usm_h%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4350	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4351	surf_usm_h%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4352	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4353	surf_usm_h%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4354	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4355	surf_usm_h%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4356	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4357	surf_usm_h%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4358	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4359	surf_usm_h%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4360	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4361	surf_usm_h%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4362	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4363	surf_usm_h%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4364	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4365	surf_usm_h%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4366	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4367	surf_usm_h%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4368	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4369	surf_usm_h%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4370
4371	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4372	surf_usm_h%c_surface(m) = building_pars_f%pars_xy(45,j,i)
4373	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4374	surf_usm_h%lambda_surf(m) = building_pars_f%pars_xy(46,j,i)
4375	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4376	surf_usm_h%c_surface_green(m) = building_pars_f%pars_xy(45,j,i)
4377	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4378	surf_usm_h%lambda_surf_green(m) = building_pars_f%pars_xy(46,j,i)
4379	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4380	surf_usm_h%c_surface_window(m) = building_pars_f%pars_xy(45,j,i)
4381	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4382	surf_usm_h%lambda_surf_window(m) = building_pars_f%pars_xy(46,j,i)
4383	ENDDO
4384
4385
4386
4387	DO l = 0, 3
4388	DO m = 1, surf_usm_v(l)%ns
4389	i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
4390	j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
4391
4392	!
4393	!-- In order to distinguish between ground floor level and
4394	!-- above-ground-floor level surfaces, set input indices.
4395	ind_wall_frac = MERGE( ind_wall_frac_gfl, ind_wall_frac_agfl, &
4396	surf_usm_v(l)%ground_level(m) )
4397	ind_win_frac = MERGE( ind_win_frac_gfl, ind_win_frac_agfl, &
4398	surf_usm_v(l)%ground_level(m) )
4399	ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
4400	surf_usm_v(l)%ground_level(m) )
4401	ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
4402	surf_usm_v(l)%ground_level(m) )
4403	ind_lai_r = MERGE( ind_lai_r_gfl, ind_lai_r_agfl, &
4404	surf_usm_v(l)%ground_level(m) )
4405	ind_lai_w = MERGE( ind_lai_w_gfl, ind_lai_w_agfl, &
4406	surf_usm_v(l)%ground_level(m) )
4407	ind_hc1 = MERGE( ind_hc1_gfl, ind_hc1_agfl, &
4408	surf_usm_v(l)%ground_level(m) )
4409	ind_hc2 = MERGE( ind_hc2_gfl, ind_hc2_agfl, &
4410	surf_usm_v(l)%ground_level(m) )
4411	ind_hc3 = MERGE( ind_hc3_gfl, ind_hc3_agfl, &
4412	surf_usm_v(l)%ground_level(m) )
4413	ind_tc1 = MERGE( ind_tc1_gfl, ind_tc1_agfl, &
4414	surf_usm_v(l)%ground_level(m) )
4415	ind_tc2 = MERGE( ind_tc2_gfl, ind_tc2_agfl, &
4416	surf_usm_v(l)%ground_level(m) )
4417	ind_tc3 = MERGE( ind_tc3_gfl, ind_tc3_agfl, &
4418	surf_usm_v(l)%ground_level(m) )
4419	ind_emis_wall = MERGE( ind_emis_wall_gfl, ind_emis_wall_agfl, &
4420	surf_usm_v(l)%ground_level(m) )
4421	ind_emis_green = MERGE( ind_emis_green_gfl, ind_emis_green_agfl, &
4422	surf_usm_v(l)%ground_level(m) )
4423	ind_emis_win = MERGE( ind_emis_win_gfl, ind_emis_win_agfl, &
4424	surf_usm_v(l)%ground_level(m) )
4425	ind_trans = MERGE( ind_trans_gfl, ind_trans_agfl, &
4426	surf_usm_v(l)%ground_level(m) )
4427	ind_z0 = MERGE( ind_z0_gfl, ind_z0_agfl, &
4428	surf_usm_v(l)%ground_level(m) )
4429	ind_z0qh = MERGE( ind_z0qh_gfl, ind_z0qh_agfl, &
4430	surf_usm_v(l)%ground_level(m) )
4431
4432	!
4433	!-- Initialize relatvie wall- (0), green- (1) and window (2) fractions
4434	IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= &
4435	building_pars_f%fill ) &
4436	surf_usm_v(l)%frac(ind_veg_wall,m) = &
4437	building_pars_f%pars_xy(ind_wall_frac,j,i)
4438	IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /= &
4439	building_pars_f%fill ) &
4440	surf_usm_v(l)%frac(ind_pav_green,m) = &
4441	building_pars_f%pars_xy(ind_green_frac_w,j,i)
4442	IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= &
4443	building_pars_f%fill ) &
4444	surf_usm_v(l)%frac(ind_wat_win,m) = &
4445	building_pars_f%pars_xy(ind_win_frac,j,i)
4446
4447	IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /= building_pars_f%fill ) &
4448	surf_usm_v(l)%lai(m) = building_pars_f%pars_xy(ind_lai_w,j,i)
4449
4450	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) &
4451	THEN
4452	surf_usm_v(l)%rho_c_wall(nzb_wall,m) = &
4453	building_pars_f%pars_xy(ind_hc1,j,i)
4454	surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = &
4455	building_pars_f%pars_xy(ind_hc1,j,i)
4456	ENDIF
4457	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4458	surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = &
4459	building_pars_f%pars_xy(ind_hc2,j,i)
4460	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4461	surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = &
4462	building_pars_f%pars_xy(ind_hc3,j,i)
4463	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) THEN
4464	surf_usm_v(l)%rho_c_green(nzb_wall,m) = &
4465	building_pars_f%pars_xy(ind_hc1,j,i)
4466	surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = &
4467	building_pars_f%pars_xy(ind_hc1,j,i)
4468	ENDIF
4469	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4470	surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4471	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4472	surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4473	IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill ) THEN
4474	surf_usm_v(l)%rho_c_window(nzb_wall,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4475	surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
4476	ENDIF
4477	IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill ) &
4478	surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
4479	IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill ) &
4480	surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
4481
4482	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4483	surf_usm_v(l)%lambda_h(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4484	surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4485	ENDIF
4486	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4487	surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4488	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4489	surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4490	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4491	surf_usm_v(l)%lambda_h_green(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4492	surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4493	ENDIF
4494	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4495	surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4496	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4497	surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4498	IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill ) THEN
4499	surf_usm_v(l)%lambda_h_window(nzb_wall,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4500	surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)
4501	ENDIF
4502	IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill ) &
4503	surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
4504	IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill ) &
4505	surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
4506
4507	IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill ) &
4508	surf_usm_v(l)%target_temp_summer(m) = building_pars_f%pars_xy(12,j,i)
4509	IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill ) &
4510	surf_usm_v(l)%target_temp_winter(m) = building_pars_f%pars_xy(13,j,i)
4511
4512	IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) &
4513	surf_usm_v(l)%emissivity(ind_veg_wall,m) = building_pars_f%pars_xy(ind_emis_wall,j,i)
4514	IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )&
4515	surf_usm_v(l)%emissivity(ind_pav_green,m) = building_pars_f%pars_xy(ind_emis_green,j,i)
4516	IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill ) &
4517	surf_usm_v(l)%emissivity(ind_wat_win,m) = building_pars_f%pars_xy(ind_emis_win,j,i)
4518
4519	IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill ) &
4520	surf_usm_v(l)%transmissivity(m) = building_pars_f%pars_xy(ind_trans,j,i)
4521
4522	IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill ) &
4523	surf_usm_v(l)%z0(m) = building_pars_f%pars_xy(ind_z0,j,i)
4524	IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill ) &
4525	surf_usm_v(l)%z0h(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4526	IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill ) &
4527	surf_usm_v(l)%z0q(m) = building_pars_f%pars_xy(ind_z0qh,j,i)
4528
4529	IF ( building_pars_f%pars_xy(ind_alb_wall,j,i) /= building_pars_f%fill ) &
4530	surf_usm_v(l)%albedo_type(ind_veg_wall,m) = building_pars_f%pars_xy(ind_alb_wall,j,i)
4531	IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill ) &
4532	surf_usm_v(l)%albedo_type(ind_pav_green,m) = building_pars_f%pars_xy(ind_alb_green,j,i)
4533	IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill ) &
4534	surf_usm_v(l)%albedo_type(ind_wat_win,m) = building_pars_f%pars_xy(ind_alb_win,j,i)
4535
4536	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4537	surf_usm_v(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4538	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4539	surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4540	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4541	surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4542	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4543	surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4544	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4545	surf_usm_v(l)%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4546	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4547	surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4548	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4549	surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4550	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4551	surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4552	IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill ) &
4553	surf_usm_v(l)%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
4554	IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill ) &
4555	surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
4556	IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill ) &
4557	surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
4558	IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill ) &
4559	surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
4560
4561	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4562	surf_usm_v(l)%c_surface(m) = building_pars_f%pars_xy(45,j,i)
4563	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4564	surf_usm_v(l)%lambda_surf(m) = building_pars_f%pars_xy(46,j,i)
4565	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4566	surf_usm_v(l)%c_surface_green(m) = building_pars_f%pars_xy(45,j,i)
4567	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4568	surf_usm_v(l)%lambda_surf_green(m) = building_pars_f%pars_xy(46,j,i)
4569	IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill ) &
4570	surf_usm_v(l)%c_surface_window(m) = building_pars_f%pars_xy(45,j,i)
4571	IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill ) &
4572	surf_usm_v(l)%lambda_surf_window(m) = building_pars_f%pars_xy(46,j,i)
4573
4574	ENDDO
4575	ENDDO
4576	ENDIF
4577	!
4578	!-- Read the surface_types array.
4579	!-- Please note, here also initialization of surface attributes is done as
4580	!-- long as _urbsurf and _surfpar files are available. Values from above
4581	!-- will be overwritten. This might be removed later, but is still in the
4582	!-- code to enable compatibility with older model version.
4583	CALL usm_read_urban_surface_types()
4584
4585	!-- init material heat model
4586	CALL usm_init_material_model()
4587
4588	!-- init anthropogenic sources of heat
4589	IF ( usm_anthropogenic_heat ) THEN
4590	!-- init anthropogenic sources of heat (from transportation for now)
4591	CALL usm_read_anthropogenic_heat()
4592	ENDIF
4593
4594	IF ( plant_canopy ) THEN
4595
4596	IF ( .NOT. ALLOCATED( pc_heating_rate) ) THEN
4597	!-- then pc_heating_rate is allocated in init_plant_canopy
4598	!-- in case of cthf /= 0 => we need to allocate it for our use here
4599	ALLOCATE( pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
4600
4601	pc_heating_rate = 0.0_wp
4602
4603	ENDIF
4604
4605	IF ( .NOT. ALLOCATED( pc_transpiration_rate) ) THEN
4606	!-- then pc_heating_rate is allocated in init_plant_canopy
4607	!-- in case of cthf /= 0 => we need to allocate it for our use here
4608	ALLOCATE( pc_transpiration_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
4609
4610	pc_transpiration_rate = 0.0_wp
4611
4612
4613	ENDIF
4614	ENDIF
4615	!
4616	!-- Check for consistent initialization.
4617	!-- Check if roughness length for momentum, or heat, exceed surface-layer
4618	!-- height and decrease local roughness length where necessary.
4619	DO m = 1, surf_usm_h%ns
4620	IF ( surf_usm_h%z0(m) >= surf_usm_h%z_mo(m) ) THEN
4621
4622	surf_usm_h%z0(m) = 0.9_wp * surf_usm_h%z_mo(m)
4623
4624	WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // &
4625	'at horizontal urban surface and is ' // &
4626	'decreased appropriately at grid point (i,j) = ', &
4627	surf_usm_h%i(m), surf_usm_h%j(m)
4628	CALL message( 'urban_surface_model_mod', 'PA0503', &
4629	0, 0, 0, 6, 0 )
4630	ENDIF
4631	IF ( surf_usm_h%z0h(m) >= surf_usm_h%z_mo(m) ) THEN
4632
4633	surf_usm_h%z0h(m) = 0.9_wp * surf_usm_h%z_mo(m)
4634	surf_usm_h%z0q(m) = 0.9_wp * surf_usm_h%z_mo(m)
4635
4636	WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // &
4637	'at horizontal urban surface and is ' // &
4638	'decreased appropriately at grid point (i,j) = ', &
4639	surf_usm_h%i(m), surf_usm_h%j(m)
4640	CALL message( 'urban_surface_model_mod', 'PA0507', &
4641	0, 0, 0, 6, 0 )
4642	ENDIF
4643	ENDDO
4644
4645	DO l = 0, 3
4646	DO m = 1, surf_usm_v(l)%ns
4647	IF ( surf_usm_v(l)%z0(m) >= surf_usm_v(l)%z_mo(m) ) THEN
4648
4649	surf_usm_v(l)%z0(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
4650
4651	WRITE( message_string, * ) 'z0 exceeds surface-layer height '//&
4652	'at vertical urban surface and is ' // &
4653	'decreased appropriately at grid point (i,j) = ', &
4654	surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff, &
4655	surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
4656	CALL message( 'urban_surface_model_mod', 'PA0503', &
4657	0, 0, 0, 6, 0 )
4658	ENDIF
4659	IF ( surf_usm_v(l)%z0h(m) >= surf_usm_v(l)%z_mo(m) ) THEN
4660
4661	surf_usm_v(l)%z0h(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
4662	surf_usm_v(l)%z0q(m) = 0.9_wp * surf_usm_v(l)%z_mo(m)
4663
4664	WRITE( message_string, * ) 'z0h exceeds surface-layer height '//&
4665	'at vertical urban surface and is ' // &
4666	'decreased appropriately at grid point (i,j) = ', &
4667	surf_usm_v(l)%i(m)+surf_usm_v(l)%ioff, &
4668	surf_usm_v(l)%j(m)+surf_usm_v(l)%joff
4669	CALL message( 'urban_surface_model_mod', 'PA0507', &
4670	0, 0, 0, 6, 0 )
4671	ENDIF
4672	ENDDO
4673	ENDDO
4674
4675	!-- Intitialization of the surface and wall/ground/roof temperature
4676
4677	!-- Initialization for restart runs
4678	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. &
4679	TRIM( initializing_actions ) /= 'cyclic_fill' ) THEN
4680
4681	!-- Calculate initial surface temperature from pt of adjacent gridbox
4682	#if ! defined( __nopointer )
4683	exn(nzb:nzt) = (hyp(nzb:nzt) / 100000.0_wp )**0.286_wp !< Exner function
4684	#endif
4685
4686	!
4687	!-- At horizontal surfaces. Please note, t_surf_h is defined on a
4688	!-- different data type, but with the same dimension.
4689	#if ! defined( __nopointer )
4690	DO m = 1, surf_usm_h%ns
4691	i = surf_usm_h%i(m)
4692	j = surf_usm_h%j(m)
4693	k = surf_usm_h%k(m)
4694
4695	t_surf_h(m) = pt(k,j,i) * exn(k)
4696	t_surf_window_h(m) = pt(k,j,i) * exn(k)
4697	t_surf_green_h(m) = pt(k,j,i) * exn(k)
4698	surf_usm_h%pt_surface(m) = pt(k,j,i) * exn(k)
4699	ENDDO
4700	!
4701	!-- At vertical surfaces.
4702	DO l = 0, 3
4703	DO m = 1, surf_usm_v(l)%ns
4704	i = surf_usm_v(l)%i(m)
4705	j = surf_usm_v(l)%j(m)
4706	k = surf_usm_v(l)%k(m)
4707
4708	t_surf_v(l)%t(m) = pt(k,j,i) * exn(k)
4709	t_surf_window_v(l)%t(m) = pt(k,j,i) * exn(k)
4710	t_surf_green_v(l)%t(m) = pt(k,j,i) * exn(k)
4711	surf_usm_v(l)%pt_surface(m) = pt(k,j,i) * exn(k)
4712	ENDDO
4713	ENDDO
4714	#endif
4715	!
4716	!-- For the sake of correct initialization, set also q_surface.
4717	!-- Note, at urban surfaces q_surface is initialized with 0.
4718	IF ( humidity ) THEN
4719	DO m = 1, surf_usm_h%ns
4720	surf_usm_h%q_surface(m) = 0.0_wp
4721	ENDDO
4722	DO l = 0, 3
4723	DO m = 1, surf_usm_v(l)%ns
4724	surf_usm_v(l)%q_surface(m) = 0.0_wp
4725	ENDDO
4726	ENDDO
4727	ENDIF
4728
4729	!-- initial values for t_wall
4730	!-- outer value is set to surface temperature
4731	!-- inner value is set to wall_inner_temperature
4732	!-- and profile is logaritmic (linear in nz).
4733	!-- Horizontal surfaces
4734	DO m = 1, surf_usm_h%ns
4735	!
4736	!-- Roof
4737	IF ( surf_usm_h%isroof_surf(m) ) THEN
4738	tin = roof_inner_temperature
4739	twin = window_inner_temperature
4740	!
4741	!-- Normal land surface
4742	ELSE
4743	tin = soil_inner_temperature
4744	twin = window_inner_temperature
4745	ENDIF
4746
4747	DO k = nzb_wall, nzt_wall+1
4748	c = REAL( k - nzb_wall, wp ) / &
4749	REAL( nzt_wall + 1 - nzb_wall , wp )
4750
4751	t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_h(m) + c * tin
4752	t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
4753	t_green_h(k,m) = t_surf_h(m)
4754	ENDDO
4755	ENDDO
4756	!
4757	!-- Vertical surfaces
4758	DO l = 0, 3
4759	DO m = 1, surf_usm_v(l)%ns
4760	!
4761	!-- Inner wall
4762	tin = wall_inner_temperature
4763	twin = window_inner_temperature
4764
4765	DO k = nzb_wall, nzt_wall+1
4766	c = REAL( k - nzb_wall, wp ) / &
4767	REAL( nzt_wall + 1 - nzb_wall , wp )
4768	t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_v(l)%t(m) + c * tin
4769	t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
4770	t_green_v(l)%t(k,m) = t_surf_v(l)%t(m)
4771	ENDDO
4772	ENDDO
4773	ENDDO
4774	ELSE
4775	!-- If specified, replace constant wall temperatures with fully 3D values from file
4776	IF ( read_wall_temp_3d ) CALL usm_read_wall_temperature()
4777	!
4778	ENDIF
4779
4780	!--
4781	!-- Possibly DO user-defined actions (e.g. define heterogeneous wall surface)
4782	CALL user_init_urban_surface
4783
4784	!-- initialize prognostic values for the first timestep
4785	t_surf_h_p = t_surf_h
4786	t_surf_v_p = t_surf_v
4787	t_surf_window_h_p = t_surf_window_h
4788	t_surf_window_v_p = t_surf_window_v
4789	t_surf_green_h_p = t_surf_green_h
4790	t_surf_green_v_p = t_surf_green_v
4791	t_surf_10cm_h_p = t_surf_10cm_h
4792	t_surf_10cm_v_p = t_surf_10cm_v
4793
4794	t_wall_h_p = t_wall_h
4795	t_wall_v_p = t_wall_v
4796	t_window_h_p = t_window_h
4797	t_window_v_p = t_window_v
4798	t_green_h_p = t_green_h
4799	t_green_v_p = t_green_v
4800
4801	!-- Adjust radiative fluxes for urban surface at model start
4802	!CALL radiation_interaction
4803	!-- TODO: interaction should be called once before first output,
4804	!-- that is not yet possible.
4805
4806	CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
4807
4808	END SUBROUTINE usm_init_urban_surface
4809
4810
4811	!------------------------------------------------------------------------------!
4812	! Description:
4813	! ------------
4814	!
4815	!> Wall model as part of the urban surface model. The model predicts wall
4816	!> temperature.
4817	!------------------------------------------------------------------------------!
4818	SUBROUTINE usm_material_heat_model
4819
4820
4821	IMPLICIT NONE
4822
4823	INTEGER(iwp) :: i,j,k,l,kw, m !< running indices
4824
4825	REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend, wintend !< tendency
4826
4827	!
4828	!-- For horizontal surfaces
4829	DO m = 1, surf_usm_h%ns
4830	!
4831	!-- Obtain indices
4832	i = surf_usm_h%i(m)
4833	j = surf_usm_h%j(m)
4834	k = surf_usm_h%k(m)
4835	!
4836	!-- prognostic equation for ground/roof temperature t_wall_h
4837	wtend(:) = 0.0_wp
4838	wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) * &
4839	( surf_usm_h%lambda_h(nzb_wall,m) * &
4840	( t_wall_h(nzb_wall+1,m) &
4841	- t_wall_h(nzb_wall,m) ) * &
4842	surf_usm_h%ddz_wall(nzb_wall+1,m) &
4843	+ surf_usm_h%frac(ind_veg_wall,m) &
4844	/ (surf_usm_h%frac(ind_veg_wall,m) &
4845	+ surf_usm_h%frac(ind_pav_green,m) ) &
4846	* surf_usm_h%wghf_eb(m) &
4847	- surf_usm_h%frac(ind_pav_green,m) &
4848	/ (surf_usm_h%frac(ind_veg_wall,m) &
4849	+ surf_usm_h%frac(ind_pav_green,m) ) &
4850	* ( surf_usm_h%lambda_h_green(nzt_wall,m) &
4851	* surf_usm_h%ddz_green(nzt_wall,m) &
4852	+ surf_usm_h%lambda_h(nzb_wall,m) &
4853	* surf_usm_h%ddz_wall(nzb_wall,m) ) &
4854	/ ( surf_usm_h%ddz_green(nzt_wall,m) &
4855	+ surf_usm_h%ddz_wall(nzb_wall,m) ) &
4856	* ( t_wall_h(nzb_wall,m) &
4857	- t_green_h(nzt_wall,m) ) ) * &
4858	surf_usm_h%ddz_wall_stag(nzb_wall,m)
4859
4860	!dummy value for testing
4861	surf_usm_h%iwghf_eb(m) = 0.
4862
4863	IF ( indoor_model ) then
4864	DO kw = nzb_wall+1, nzt_wall-1
4865	wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m)) &
4866	* ( surf_usm_h%lambda_h(kw,m) &
4867	* ( t_wall_h(kw+1,m) - t_wall_h(kw,m) ) &
4868	* surf_usm_h%ddz_wall(kw+1,m) &
4869	- surf_usm_h%lambda_h(kw-1,m) &
4870	* ( t_wall_h(kw,m) - t_wall_h(kw-1,m) ) &
4871	* surf_usm_h%ddz_wall(kw,m) &
4872	) * surf_usm_h%ddz_wall_stag(kw,m)
4873	ENDDO
4874	wtend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m)) * &
4875	( surf_usm_h%lambda_h(nzt_wall-1,m) * &
4876	( t_wall_h(nzt_wall,m) &
4877	- t_wall_h(nzt_wall-1,m) ) * &
4878	surf_usm_h%ddz_wall(nzt_wall,m) &
4879	+ surf_usm_h%iwghf_eb(m) ) * &
4880	surf_usm_h%ddz_wall_stag(nzt_wall,m)
4881	ELSE
4882	DO kw = nzb_wall+1, nzt_wall
4883	wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m)) &
4884	* ( surf_usm_h%lambda_h(kw,m) &
4885	* ( t_wall_h(kw+1,m) - t_wall_h(kw,m) ) &
4886	* surf_usm_h%ddz_wall(kw+1,m) &
4887	- surf_usm_h%lambda_h(kw-1,m) &
4888	* ( t_wall_h(kw,m) - t_wall_h(kw-1,m) ) &
4889	* surf_usm_h%ddz_wall(kw,m) &
4890	) * surf_usm_h%ddz_wall_stag(kw,m)
4891	ENDDO
4892	ENDIF
4893
4894	t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m) &
4895	+ dt_3d * ( tsc(2) &
4896	* wtend(nzb_wall:nzt_wall) + tsc(3) &
4897	* surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )
4898
4899	!-- prognostic equation for ground/roof window temperature t_window_h
4900	wintend(:) = 0.0_wp
4901	wintend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m)) * &
4902	( surf_usm_h%lambda_h_window(nzb_wall,m) * &
4903	( t_window_h(nzb_wall+1,m) &
4904	- t_window_h(nzb_wall,m) ) * &
4905	surf_usm_h%ddz_window(nzb_wall+1,m) &
4906	+ surf_usm_h%wghf_eb_window(m) &
4907	+ surf_usm_h%rad_sw_in(m) &
4908	* (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
4909	* surf_usm_h%zw_window(nzb_wall,m) ) ) &
4910	) * surf_usm_h%ddz_window_stag(nzb_wall,m)
4911
4912	IF ( indoor_model ) then
4913	DO kw = nzb_wall+1, nzt_wall-1
4914	wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m)) &
4915	* ( surf_usm_h%lambda_h_window(kw,m) &
4916	* ( t_window_h(kw+1,m) - t_window_h(kw,m) ) &
4917	* surf_usm_h%ddz_window(kw+1,m) &
4918	- surf_usm_h%lambda_h_window(kw-1,m) &
4919	* ( t_window_h(kw,m) - t_window_h(kw-1,m) ) &
4920	* surf_usm_h%ddz_window(kw,m) &
4921	+ surf_usm_h%rad_sw_in(m) &
4922	* (exp(-surf_usm_h%transmissivity(m) &
4923	* surf_usm_h%zw_window(kw-1,m) ) &
4924	- exp(-surf_usm_h%transmissivity(m) &
4925	* surf_usm_h%zw_window(kw,m) ) ) &
4926	) * surf_usm_h%ddz_window_stag(kw,m)
4927
4928	ENDDO
4929	wintend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m)) * &
4930	( surf_usm_h%lambda_h_window(nzt_wall-1,m) * &
4931	( t_window_h(nzt_wall,m) &
4932	- t_window_h(nzt_wall-1,m) ) * &
4933	surf_usm_h%ddz_window(nzt_wall,m) &
4934	+ surf_usm_h%iwghf_eb_window(m) &
4935	+ surf_usm_h%rad_sw_in(m) &
4936	* (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
4937	* surf_usm_h%zw_window(nzt_wall,m) ) ) &
4938	) * surf_usm_h%ddz_window_stag(nzt_wall,m)
4939	ELSE
4940	DO kw = nzb_wall+1, nzt_wall
4941	wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m)) &
4942	* ( surf_usm_h%lambda_h_window(kw,m) &
4943	* ( t_window_h(kw+1,m) - t_window_h(kw,m) ) &
4944	* surf_usm_h%ddz_window(kw+1,m) &
4945	- surf_usm_h%lambda_h_window(kw-1,m) &
4946	* ( t_window_h(kw,m) - t_window_h(kw-1,m) ) &
4947	* surf_usm_h%ddz_window(kw,m) &
4948	+ surf_usm_h%rad_sw_in(m) &
4949	* (exp(-surf_usm_h%transmissivity(m) &
4950	* surf_usm_h%zw_window(kw-1,m) ) &
4951	- exp(-surf_usm_h%transmissivity(m) &
4952	* surf_usm_h%zw_window(kw,m) ) ) &
4953	) * surf_usm_h%ddz_window_stag(kw,m)
4954
4955	ENDDO
4956	ENDIF
4957
4958	t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m) &
4959	+ dt_3d * ( tsc(2) &
4960	* wintend(nzb_wall:nzt_wall) + tsc(3) &
4961	* surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )
4962
4963	!
4964	!-- calculate t_wall tendencies for the next Runge-Kutta step
4965	IF ( timestep_scheme(1:5) == 'runge' ) THEN
4966	IF ( intermediate_timestep_count == 1 ) THEN
4967	DO kw = nzb_wall, nzt_wall
4968	surf_usm_h%tt_wall_m(kw,m) = wtend(kw)
4969	ENDDO
4970	ELSEIF ( intermediate_timestep_count < &
4971	intermediate_timestep_count_max ) THEN
4972	DO kw = nzb_wall, nzt_wall
4973	surf_usm_h%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) + &
4974	5.3125_wp * surf_usm_h%tt_wall_m(kw,m)
4975	ENDDO
4976	ENDIF
4977	ENDIF
4978
4979	!-- calculate t_window tendencies for the next Runge-Kutta step
4980	IF ( timestep_scheme(1:5) == 'runge' ) THEN
4981	IF ( intermediate_timestep_count == 1 ) THEN
4982	DO kw = nzb_wall, nzt_wall
4983	surf_usm_h%tt_window_m(kw,m) = wintend(kw)
4984	ENDDO
4985	ELSEIF ( intermediate_timestep_count < &
4986	intermediate_timestep_count_max ) THEN
4987	DO kw = nzb_wall, nzt_wall
4988	surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) + &
4989	5.3125_wp * surf_usm_h%tt_window_m(kw,m)
4990	ENDDO
4991	ENDIF
4992	ENDIF
4993	ENDDO
4994
4995	!
4996	!-- For vertical surfaces
4997	DO l = 0, 3
4998	DO m = 1, surf_usm_v(l)%ns
4999	!
5000	!-- Obtain indices
5001	i = surf_usm_v(l)%i(m)
5002	j = surf_usm_v(l)%j(m)
5003	k = surf_usm_v(l)%k(m)
5004	!
5005	!-- prognostic equation for wall temperature t_wall_v
5006	wtend(:) = 0.0_wp
5007
5008	wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) * &
5009	( surf_usm_v(l)%lambda_h(nzb_wall,m) * &
5010	( t_wall_v(l)%t(nzb_wall+1,m) &
5011	- t_wall_v(l)%t(nzb_wall,m) ) * &
5012	surf_usm_v(l)%ddz_wall(nzb_wall+1,m) &
5013	+ surf_usm_v(l)%frac(ind_veg_wall,m) &
5014	/ (surf_usm_v(l)%frac(ind_veg_wall,m) &
5015	+ surf_usm_v(l)%frac(ind_pav_green,m) ) &
5016	* surf_usm_v(l)%wghf_eb(m) &
5017	- surf_usm_v(l)%frac(ind_pav_green,m) &
5018	/ (surf_usm_v(l)%frac(ind_veg_wall,m) &
5019	+ surf_usm_v(l)%frac(ind_pav_green,m) ) &
5020	* ( surf_usm_v(l)%lambda_h_green(nzt_wall,m) &
5021	* surf_usm_v(l)%ddz_green(nzt_wall,m) &
5022	+ surf_usm_v(l)%lambda_h(nzb_wall,m) &
5023	* surf_usm_v(l)%ddz_wall(nzb_wall,m) ) &
5024	/ ( surf_usm_v(l)%ddz_green(nzt_wall,m) &
5025	+ surf_usm_v(l)%ddz_wall(nzb_wall,m) ) &
5026	* ( t_wall_v(l)%t(nzb_wall,m) &
5027	- t_green_v(l)%t(nzt_wall,m) ) ) * &
5028	surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
5029
5030	!dummy value for testing
5031	surf_usm_v(l)%iwghf_eb(m) = 0.
5032
5033	IF ( indoor_model ) then
5034	DO kw = nzb_wall+1, nzt_wall-1
5035	wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m)) &
5036	* ( surf_usm_v(l)%lambda_h(kw,m) &
5037	* ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5038	* surf_usm_v(l)%ddz_wall(kw+1,m) &
5039	- surf_usm_v(l)%lambda_h(kw-1,m) &
5040	* ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5041	* surf_usm_v(l)%ddz_wall(kw,m) &
5042	) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5043	ENDDO
5044	wtend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m)) * &
5045	( surf_usm_v(l)%lambda_h(nzt_wall-1,m) * &
5046	( t_wall_v(l)%t(nzt_wall,m) &
5047	- t_wall_v(l)%t(nzt_wall-1,m) ) * &
5048	surf_usm_v(l)%ddz_wall(nzt_wall,m) &
5049	+ surf_usm_v(l)%iwghf_eb(m) ) * &
5050	surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
5051	ELSE
5052	DO kw = nzb_wall+1, nzt_wall
5053	wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m)) &
5054	* ( surf_usm_v(l)%lambda_h(kw,m) &
5055	* ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
5056	* surf_usm_v(l)%ddz_wall(kw+1,m) &
5057	- surf_usm_v(l)%lambda_h(kw-1,m) &
5058	* ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
5059	* surf_usm_v(l)%ddz_wall(kw,m) &
5060	) * surf_usm_v(l)%ddz_wall_stag(kw,m)
5061	ENDDO
5062	ENDIF
5063
5064	t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) = &
5065	t_wall_v(l)%t(nzb_wall:nzt_wall,m) &
5066	+ dt_3d * ( tsc(2) &
5067	* wtend(nzb_wall:nzt_wall) + tsc(3) &
5068	* surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall,m) )
5069
5070	!-- prognostic equation for window temperature t_window_v
5071	wintend(:) = 0.0_wp
5072	wintend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m)) * &
5073	( surf_usm_v(l)%lambda_h_window(nzb_wall,m) * &
5074	( t_window_v(l)%t(nzb_wall+1,m) &
5075	- t_window_v(l)%t(nzb_wall,m) ) * &
5076	surf_usm_v(l)%ddz_window(nzb_wall+1,m) &
5077	+ surf_usm_v(l)%wghf_eb_window(m) &
5078	+ surf_usm_v(l)%rad_sw_in(m) &
5079	* (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
5080	* surf_usm_v(l)%zw_window(nzb_wall,m) ) ) &
5081	) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
5082
5083	IF ( indoor_model ) then
5084	DO kw = nzb_wall+1, nzt_wall -1
5085	wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m)) &
5086	* ( surf_usm_v(l)%lambda_h_window(kw,m) &
5087	* ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5088	* surf_usm_v(l)%ddz_window(kw+1,m) &
5089	- surf_usm_v(l)%lambda_h_window(kw-1,m) &
5090	* ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5091	* surf_usm_v(l)%ddz_window(kw,m) &
5092	+ surf_usm_v(l)%rad_sw_in(m) &
5093	* (exp(-surf_usm_v(l)%transmissivity(m) &
5094	* surf_usm_v(l)%zw_window(kw-1,m) ) &
5095	- exp(-surf_usm_v(l)%transmissivity(m) &
5096	* surf_usm_v(l)%zw_window(kw,m) ) ) &
5097	) * surf_usm_v(l)%ddz_window_stag(kw,m)
5098	ENDDO
5099	wintend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m)) * &
5100	( surf_usm_v(l)%lambda_h_window(nzt_wall-1,m) * &
5101	( t_window_v(l)%t(nzt_wall,m) &
5102	- t_window_v(l)%t(nzt_wall-1,m) ) * &
5103	surf_usm_v(l)%ddz_window(nzt_wall,m) &
5104	+ surf_usm_v(l)%iwghf_eb_window(m) &
5105	+ surf_usm_v(l)%rad_sw_in(m) &
5106	* (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
5107	* surf_usm_v(l)%zw_window(nzt_wall,m) ) ) &
5108	) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
5109	ELSE
5110	DO kw = nzb_wall+1, nzt_wall
5111	wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m)) &
5112	* ( surf_usm_v(l)%lambda_h_window(kw,m) &
5113	* ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
5114	* surf_usm_v(l)%ddz_window(kw+1,m) &
5115	- surf_usm_v(l)%lambda_h_window(kw-1,m) &
5116	* ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
5117	* surf_usm_v(l)%ddz_window(kw,m) &
5118	+ surf_usm_v(l)%rad_sw_in(m) &
5119	* (exp(-surf_usm_v(l)%transmissivity(m) &
5120	* surf_usm_v(l)%zw_window(kw-1,m) ) &
5121	- exp(-surf_usm_v(l)%transmissivity(m) &
5122	* surf_usm_v(l)%zw_window(kw,m) ) ) &
5123	) * surf_usm_v(l)%ddz_window_stag(kw,m)
5124	ENDDO
5125	ENDIF
5126
5127	t_window_v_p(l)%t(nzb_wall:nzt_wall,m) = &
5128	t_window_v(l)%t(nzb_wall:nzt_wall,m) &
5129	+ dt_3d * ( tsc(2) &
5130	* wintend(nzb_wall:nzt_wall) + tsc(3) &
5131	* surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )
5132
5133	!
5134	!-- calculate t_wall tendencies for the next Runge-Kutta step
5135	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5136	IF ( intermediate_timestep_count == 1 ) THEN
5137	DO kw = nzb_wall, nzt_wall
5138	surf_usm_v(l)%tt_wall_m(kw,m) = wtend(kw)
5139	ENDDO
5140	ELSEIF ( intermediate_timestep_count < &
5141	intermediate_timestep_count_max ) THEN
5142	DO kw = nzb_wall, nzt_wall
5143	surf_usm_v(l)%tt_wall_m(kw,m) = &
5144	- 9.5625_wp * wtend(kw) + &
5145	5.3125_wp * surf_usm_v(l)%tt_wall_m(kw,m)
5146	ENDDO
5147	ENDIF
5148	ENDIF
5149	!-- calculate t_window tendencies for the next Runge-Kutta step
5150	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5151	IF ( intermediate_timestep_count == 1 ) THEN
5152	DO kw = nzb_wall, nzt_wall
5153	surf_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
5154	ENDDO
5155	ELSEIF ( intermediate_timestep_count < &
5156	intermediate_timestep_count_max ) THEN
5157	DO kw = nzb_wall, nzt_wall
5158	surf_usm_v(l)%tt_window_m(kw,m) = &
5159	- 9.5625_wp * wintend(kw) + &
5160	5.3125_wp * surf_usm_v(l)%tt_window_m(kw,m)
5161	ENDDO
5162	ENDIF
5163	ENDIF
5164	ENDDO
5165	ENDDO
5166
5167	END SUBROUTINE usm_material_heat_model
5168
5169	!------------------------------------------------------------------------------!
5170	! Description:
5171	! ------------
5172	!
5173	!> Green and substrate model as part of the urban surface model. The model predicts ground
5174	!> temperatures.
5175	!------------------------------------------------------------------------------!
5176	SUBROUTINE usm_green_heat_model
5177
5178
5179	IMPLICIT NONE
5180
5181	INTEGER(iwp) :: i,j,k,l,kw, m !< running indices
5182
5183	REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: gtend !< tendency
5184
5185	!
5186	!-- For horizontal surfaces
5187	DO m = 1, surf_usm_h%ns
5188	!
5189	!-- Obtain indices
5190	i = surf_usm_h%i(m)
5191	j = surf_usm_h%j(m)
5192	k = surf_usm_h%k(m)
5193
5194	t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
5195	!
5196	!-- prognostic equation for ground/roof temperature t_green_h
5197	gtend(:) = 0.0_wp
5198	gtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_green(nzb_wall,m)) * &
5199	( surf_usm_h%lambda_h_green(nzb_wall,m) * &
5200	( t_green_h(nzb_wall+1,m) &
5201	- t_green_h(nzb_wall,m) ) * &
5202	surf_usm_h%ddz_green(nzb_wall+1,m) &
5203	+ surf_usm_h%wghf_eb_green(m) ) * &
5204	surf_usm_h%ddz_green_stag(nzb_wall,m)
5205
5206	DO kw = nzb_wall+1, nzt_wall
5207	gtend(kw) = (1.0_wp / surf_usm_h%rho_c_green(kw,m)) &
5208	* ( surf_usm_h%lambda_h_green(kw,m) &
5209	* ( t_green_h(kw+1,m) - t_green_h(kw,m) ) &
5210	* surf_usm_h%ddz_green(kw+1,m) &
5211	- surf_usm_h%lambda_h_green(kw-1,m) &
5212	* ( t_green_h(kw,m) - t_green_h(kw-1,m) ) &
5213	* surf_usm_h%ddz_green(kw,m) &
5214	) * surf_usm_h%ddz_green_stag(kw,m)
5215	ENDDO
5216
5217	t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m) &
5218	+ dt_3d * ( tsc(2) &
5219	* gtend(nzb_wall:nzt_wall) + tsc(3) &
5220	* surf_usm_h%tt_green_m(nzb_wall:nzt_wall,m) )
5221
5222
5223	!
5224	!-- calculate t_green tendencies for the next Runge-Kutta step
5225	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5226	IF ( intermediate_timestep_count == 1 ) THEN
5227	DO kw = nzb_wall, nzt_wall
5228	surf_usm_h%tt_green_m(kw,m) = gtend(kw)
5229	ENDDO
5230	ELSEIF ( intermediate_timestep_count < &
5231	intermediate_timestep_count_max ) THEN
5232	DO kw = nzb_wall, nzt_wall
5233	surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + &
5234	5.3125_wp * surf_usm_h%tt_green_m(kw,m)
5235	ENDDO
5236	ENDIF
5237	ENDIF
5238	ENDDO
5239
5240	!
5241	!-- For vertical surfaces
5242	DO l = 0, 3
5243	DO m = 1, surf_usm_v(l)%ns
5244	!
5245	!-- Obtain indices
5246	i = surf_usm_v(l)%i(m)
5247	j = surf_usm_v(l)%j(m)
5248	k = surf_usm_v(l)%k(m)
5249
5250	t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
5251	!
5252	!-- prognostic equation for green temperature t_green_v
5253	gtend(:) = 0.0_wp
5254	gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
5255	( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
5256	( t_green_v(l)%t(nzb_wall+1,m) &
5257	- t_green_v(l)%t(nzb_wall,m) ) * &
5258	surf_usm_v(l)%ddz_green(nzb_wall+1,m) &
5259	+ surf_usm_v(l)%wghf_eb(m) ) * &
5260	surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
5261
5262	DO kw = nzb_wall+1, nzt_wall
5263	gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m)) &
5264	* ( surf_usm_v(l)%lambda_h_green(kw,m) &
5265	* ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
5266	* surf_usm_v(l)%ddz_green(kw+1,m) &
5267	- surf_usm_v(l)%lambda_h(kw-1,m) &
5268	* ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
5269	* surf_usm_v(l)%ddz_green(kw,m) ) &
5270	* surf_usm_v(l)%ddz_green_stag(kw,m)
5271	ENDDO
5272
5273	t_green_v_p(l)%t(nzb_wall:nzt_wall,m) = &
5274	t_green_v(l)%t(nzb_wall:nzt_wall,m) &
5275	+ dt_3d * ( tsc(2) &
5276	* gtend(nzb_wall:nzt_wall) + tsc(3) &
5277	* surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall,m) )
5278
5279	!
5280	!-- calculate t_green tendencies for the next Runge-Kutta step
5281	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5282	IF ( intermediate_timestep_count == 1 ) THEN
5283	DO kw = nzb_wall, nzt_wall
5284	surf_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
5285	ENDDO
5286	ELSEIF ( intermediate_timestep_count < &
5287	intermediate_timestep_count_max ) THEN
5288	DO kw = nzb_wall, nzt_wall
5289	surf_usm_v(l)%tt_green_m(kw,m) = &
5290	- 9.5625_wp * gtend(kw) + &
5291	5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
5292	ENDDO
5293	ENDIF
5294	ENDIF
5295
5296	ENDDO
5297	ENDDO
5298
5299	END SUBROUTINE usm_green_heat_model
5300
5301	!------------------------------------------------------------------------------!
5302	! Description:
5303	! ------------
5304	!> Parin for &usm_par for urban surface model
5305	!------------------------------------------------------------------------------!
5306	SUBROUTINE usm_parin
5307
5308	IMPLICIT NONE
5309
5310	CHARACTER (LEN=80) :: line !< string containing current line of file PARIN
5311
5312	NAMELIST /urban_surface_par/ &
5313	building_type, &
5314	land_category, &
5315	naheatlayers, &
5316	pedestrian_category, &
5317	roughness_concrete, &
5318	read_wall_temp_3d, &
5319	roof_category, &
5320	urban_surface, &
5321	usm_anthropogenic_heat, &
5322	usm_material_model, &
5323	wall_category, &
5324	indoor_model, &
5325	wall_inner_temperature, &
5326	roof_inner_temperature, &
5327	soil_inner_temperature, &
5328	window_inner_temperature
5329
5330	NAMELIST /urban_surface_parameters/ &
5331	building_type, &
5332	land_category, &
5333	naheatlayers, &
5334	pedestrian_category, &
5335	roughness_concrete, &
5336	read_wall_temp_3d, &
5337	roof_category, &
5338	urban_surface, &
5339	usm_anthropogenic_heat, &
5340	usm_material_model, &
5341	wall_category, &
5342	indoor_model, &
5343	wall_inner_temperature, &
5344	roof_inner_temperature, &
5345	soil_inner_temperature, &
5346	window_inner_temperature
5347	!
5348	!-- Try to find urban surface model package
5349	REWIND ( 11 )
5350	line = ' '
5351	DO WHILE ( INDEX( line, '&urban_surface_parameters' ) == 0 )
5352	READ ( 11, '(A)', END=10 ) line
5353	ENDDO
5354	BACKSPACE ( 11 )
5355
5356	!
5357	!-- Read user-defined namelist
5358	READ ( 11, urban_surface_parameters )
5359	!
5360	!-- Set flag that indicates that the land surface model is switched on
5361	urban_surface = .TRUE.
5362
5363	GOTO 12
5364	!
5365	!-- Try to find old namelist
5366	10 REWIND ( 11 )
5367	line = ' '
5368	DO WHILE ( INDEX( line, '&urban_surface_par' ) == 0 )
5369	READ ( 11, '(A)', END=12 ) line
5370	ENDDO
5371	BACKSPACE ( 11 )
5372
5373	!
5374	!-- Read user-defined namelist
5375	READ ( 11, urban_surface_par )
5376
5377	message_string = 'namelist urban_surface_par is deprecated and will be ' // &
5378	'removed in near future. Please use namelist ' // &
5379	'urban_surface_parameters instead'
5380	CALL message( 'usm_parin', 'PA0487', 0, 1, 0, 6, 0 )
5381	!
5382	!-- Set flag that indicates that the land surface model is switched on
5383	urban_surface = .TRUE.
5384
5385	12 CONTINUE
5386
5387
5388	END SUBROUTINE usm_parin
5389
5390	!------------------------------------------------------------------------------!
5391	! Description:
5392	! ------------
5393	!> Calculates temperature near surface (10 cm) for indoor model
5394	!------------------------------------------------------------------------------!
5395	SUBROUTINE usm_temperature_near_surface
5396
5397	IMPLICIT NONE
5398
5399	INTEGER(iwp) :: i, j, k, l, m !< running indices
5400
5401	!
5402	!-- First, treat horizontal surface elements
5403	DO m = 1, surf_usm_h%ns
5404
5405	!-- Get indices of respective grid point
5406	i = surf_usm_h%i(m)
5407	j = surf_usm_h%j(m)
5408	k = surf_usm_h%k(m)
5409
5410	t_surf_10cm_h(m) = surf_usm_h%pt_surface(m) + surf_usm_h%ts(m) / kappa &
5411	* ( log( 0.1_wp / surf_usm_h%z0h(m) ) &
5412	- psi_h( 0.1_wp / surf_usm_h%ol(m) ) &
5413	+ psi_h( surf_usm_h%z0h(m) / surf_usm_h%ol(m) ) )
5414
5415	ENDDO
5416	!
5417	!-- Now, treat vertical surface elements
5418	DO l = 0, 3
5419	DO m = 1, surf_usm_v(l)%ns
5420
5421	!-- Get indices of respective grid point
5422	i = surf_usm_v(l)%i(m)
5423	j = surf_usm_v(l)%j(m)
5424	k = surf_usm_v(l)%k(m)
5425
5426	t_surf_10cm_v(l)%t(m) =surf_usm_v(l)%pt_surface(m) + surf_usm_v(l)%ts(m) / kappa &
5427	* ( log( 0.1_wp / surf_usm_v(l)%z0h(m) ) &
5428	- psi_h( 0.1_wp / surf_usm_v(l)%ol(m) ) &
5429	+ psi_h( surf_usm_v(l)%z0h(m) / surf_usm_v(l)%ol(m) ) )
5430
5431	ENDDO
5432
5433	ENDDO
5434
5435
5436	END SUBROUTINE usm_temperature_near_surface
5437
5438
5439
5440	!------------------------------------------------------------------------------!
5441	! Description:
5442	! ------------
5443	!
5444	!> This subroutine is part of the urban surface model.
5445	!> It reads daily heat produced by anthropogenic sources
5446	!> and the diurnal cycle of the heat.
5447	!------------------------------------------------------------------------------!
5448	SUBROUTINE usm_read_anthropogenic_heat
5449
5450	INTEGER(iwp) :: i,j,k,ii
5451	REAL(wp) :: heat
5452
5453	!-- allocation of array of sources of anthropogenic heat and their diural profile
5454	ALLOCATE( aheat(naheatlayers,nys:nyn,nxl:nxr) )
5455	ALLOCATE( aheatprof(naheatlayers,0:24) )
5456
5457	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5458	!-- read daily amount of heat and its daily cycle
5459	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5460	aheat = 0.0_wp
5461	DO ii = 0, io_blocks-1
5462	IF ( ii == io_group ) THEN
5463
5464	!-- open anthropogenic heat file
5465	OPEN( 151, file='ANTHROPOGENIC_HEAT'//TRIM(coupling_char), action='read', &
5466	status='old', form='formatted', err=11 )
5467	i = 0
5468	j = 0
5469	DO
5470	READ( 151, *, err=12, end=13 ) i, j, k, heat
5471	IF ( i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn ) THEN
5472	IF ( k <= naheatlayers .AND. k > get_topography_top_index_ji( j, i, 's' ) ) THEN
5473	!-- write heat into the array
5474	aheat(k,j,i) = heat
5475	ENDIF
5476	ENDIF
5477	CYCLE
5478	12 WRITE(message_string,'(a,2i4)') 'error in file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' after line ',i,j
5479	CALL message( 'usm_read_anthropogenic_heat', 'PA0515', 0, 1, 0, 6, 0 )
5480	ENDDO
5481	13 CLOSE(151)
5482	CYCLE
5483	11 message_string = 'file ANTHROPOGENIC_HEAT'//TRIM(coupling_char)//' does not exist'
5484	CALL message( 'usm_read_anthropogenic_heat', 'PA0516', 1, 2, 0, 6, 0 )
5485	ENDIF
5486
5487	#if defined( __parallel )
5488	CALL MPI_BARRIER( comm2d, ierr )
5489	#endif
5490	ENDDO
5491
5492	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5493	!-- read diurnal profiles of heat sources
5494	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5495	aheatprof = 0.0_wp
5496	DO ii = 0, io_blocks-1
5497	IF ( ii == io_group ) THEN
5498
5499	!-- open anthropogenic heat profile file
5500	OPEN( 151, file='ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char), action='read', &
5501	status='old', form='formatted', err=21 )
5502	i = 0
5503	DO
5504	READ( 151, *, err=22, end=23 ) i, k, heat
5505	IF ( i >= 0 .AND. i <= 24 .AND. k <= naheatlayers ) THEN
5506	!-- write heat into the array
5507	aheatprof(k,i) = heat
5508	ENDIF
5509	CYCLE
5510	22 WRITE(message_string,'(a,i4)') 'error in file ANTHROPOGENIC_HEAT_PROFILE'// &
5511	TRIM(coupling_char)//' after line ',i
5512	CALL message( 'usm_read_anthropogenic_heat', 'PA0517', 0, 1, 0, 6, 0 )
5513	ENDDO
5514	aheatprof(:,24) = aheatprof(:,0)
5515	23 CLOSE(151)
5516	CYCLE
5517	21 message_string = 'file ANTHROPOGENIC_HEAT_PROFILE'//TRIM(coupling_char)//' does not exist'
5518	CALL message( 'usm_read_anthropogenic_heat', 'PA0518', 1, 2, 0, 6, 0 )
5519	ENDIF
5520
5521	#if defined( __parallel )
5522	CALL MPI_BARRIER( comm2d, ierr )
5523	#endif
5524	ENDDO
5525
5526	END SUBROUTINE usm_read_anthropogenic_heat
5527
5528
5529	!------------------------------------------------------------------------------!
5530	! Description:
5531	! ------------
5532	!> Soubroutine reads t_surf and t_wall data from restart files
5533	!------------------------------------------------------------------------------!
5534	SUBROUTINE usm_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
5535	nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,&
5536	nys_on_file, found )
5537
5538
5539	USE control_parameters, &
5540	ONLY: length, restart_string
5541
5542	IMPLICIT NONE
5543
5544	CHARACTER (LEN=1) :: dum !< dummy to create correct string for reading input variable
5545
5546	INTEGER(iwp) :: l !< index variable for surface type
5547	INTEGER(iwp) :: i !< running index over input files
5548	INTEGER(iwp) :: k !< running index over previous input files covering current local domain
5549	INTEGER(iwp) :: ns_h_on_file_usm !< number of horizontal surface elements (urban type) on file
5550	INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain
5551	INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain
5552	INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain
5553	INTEGER(iwp) :: nxrc !< index of right boundary on current subdomain
5554	INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain
5555	INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain
5556	INTEGER(iwp) :: nync !< index of north boundary on current subdomain
5557	INTEGER(iwp) :: nynf !< index of north boundary on former subdomain
5558	INTEGER(iwp) :: nyn_on_file !< index of north boundary on former local domain
5559	INTEGER(iwp) :: nysc !< index of south boundary on current subdomain
5560	INTEGER(iwp) :: nysf !< index of south boundary on former subdomain
5561	INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain
5562
5563	INTEGER(iwp) :: ns_v_on_file_usm(0:3) !< number of vertical surface elements (urban type) on file
5564
5565	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: start_index_on_file
5566	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: end_index_on_file
5567
5568	LOGICAL, INTENT(OUT) :: found
5569
5570	REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tmp_surf_h, tmp_surf_window_h, tmp_surf_green_h
5571	REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: tmp_wall_h, tmp_window_h, tmp_green_h
5572
5573	TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE :: tmp_surf_v, tmp_surf_window_v, tmp_surf_green_v
5574	TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE :: tmp_wall_v, tmp_window_v, tmp_green_v
5575
5576
5577	found = .TRUE.
5578
5579
5580	SELECT CASE ( restart_string(1:length) )
5581
5582	CASE ( 'ns_h_on_file_usm')
5583	IF ( k == 1 ) THEN
5584	READ ( 13 ) ns_h_on_file_usm
5585
5586	IF ( ALLOCATED( tmp_surf_h ) ) DEALLOCATE( tmp_surf_h )
5587	IF ( ALLOCATED( tmp_wall_h ) ) DEALLOCATE( tmp_wall_h )
5588	IF ( ALLOCATED( tmp_surf_window_h ) ) &
5589	DEALLOCATE( tmp_surf_window_h )
5590	IF ( ALLOCATED( tmp_window_h) ) DEALLOCATE( tmp_window_h )
5591	IF ( ALLOCATED( tmp_surf_green_h) ) &
5592	DEALLOCATE( tmp_surf_green_h )
5593	IF ( ALLOCATED( tmp_green_h) ) DEALLOCATE( tmp_green_h )
5594
5595	!
5596	!-- Allocate temporary arrays for reading data on file. Note,
5597	!-- the size of allocated surface elements do not necessarily
5598	!-- need to match the size of present surface elements on
5599	!-- current processor, as the number of processors between
5600	!-- restarts can change.
5601	ALLOCATE( tmp_surf_h(1:ns_h_on_file_usm) )
5602	ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1, &
5603	1:ns_h_on_file_usm) )
5604	ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
5605	ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1, &
5606	1:ns_h_on_file_usm) )
5607	ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
5608	ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1, &
5609	1:ns_h_on_file_usm) )
5610
5611	ENDIF
5612
5613	CASE ( 'ns_v_on_file_usm')
5614	IF ( k == 1 ) THEN
5615	READ ( 13 ) ns_v_on_file_usm
5616
5617	DO l = 0, 3
5618	IF ( ALLOCATED( tmp_surf_v(l)%t ) ) &
5619	DEALLOCATE( tmp_surf_v(l)%t )
5620	IF ( ALLOCATED( tmp_wall_v(l)%t ) ) &
5621	DEALLOCATE( tmp_wall_v(l)%t )
5622	IF ( ALLOCATED( tmp_surf_window_v(l)%t ) ) &
5623	DEALLOCATE( tmp_surf_window_v(l)%t )
5624	IF ( ALLOCATED( tmp_window_v(l)%t ) ) &
5625	DEALLOCATE( tmp_window_v(l)%t )
5626	IF ( ALLOCATED( tmp_surf_green_v(l)%t ) ) &
5627	DEALLOCATE( tmp_surf_green_v(l)%t )
5628	IF ( ALLOCATED( tmp_green_v(l)%t ) ) &
5629	DEALLOCATE( tmp_green_v(l)%t )
5630	ENDDO
5631
5632	!
5633	!-- Allocate temporary arrays for reading data on file. Note,
5634	!-- the size of allocated surface elements do not necessarily
5635	!-- need to match the size of present surface elements on
5636	!-- current processor, as the number of processors between
5637	!-- restarts can change.
5638	DO l = 0, 3
5639	ALLOCATE( tmp_surf_v(l)%t(1:ns_v_on_file_usm(l)) )
5640	ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1, &
5641	1:ns_v_on_file_usm(l) ) )
5642	ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
5643	ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1, &
5644	1:ns_v_on_file_usm(l) ) )
5645	ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
5646	ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1, &
5647	1:ns_v_on_file_usm(l) ) )
5648	ENDDO
5649
5650	ENDIF
5651
5652	CASE ( 'usm_start_index_h', 'usm_start_index_v' )
5653	IF ( k == 1 ) THEN
5654
5655	IF ( ALLOCATED( start_index_on_file ) ) &
5656	DEALLOCATE( start_index_on_file )
5657
5658	ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, &
5659	nxl_on_file:nxr_on_file) )
5660
5661	READ ( 13 ) start_index_on_file
5662
5663	ENDIF
5664
5665	CASE ( 'usm_end_index_h', 'usm_end_index_v' )
5666	IF ( k == 1 ) THEN
5667
5668	IF ( ALLOCATED( end_index_on_file ) ) &
5669	DEALLOCATE( end_index_on_file )
5670
5671	ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file, &
5672	nxl_on_file:nxr_on_file) )
5673
5674	READ ( 13 ) end_index_on_file
5675
5676	ENDIF
5677
5678	CASE ( 't_surf_h' )
5679	#if defined( __nopointer )
5680	IF ( k == 1 ) THEN
5681	IF ( .NOT. ALLOCATED( t_surf_h ) ) &
5682	ALLOCATE( t_surf_h(1:surf_usm_h%ns) )
5683	READ ( 13 ) tmp_surf_h
5684	ENDIF
5685	CALL surface_restore_elements( &
5686	t_surf_h, tmp_surf_h, &
5687	surf_usm_h%start_index, &
5688	start_index_on_file, &
5689	end_index_on_file, &
5690	nxlc, nysc, &
5691	nxlf, nxrf, nysf, nynf, &
5692	nys_on_file, nyn_on_file, &
5693	nxl_on_file,nxr_on_file )
5694	#else
5695	IF ( k == 1 ) THEN
5696	IF ( .NOT. ALLOCATED( t_surf_h_1 ) ) &
5697	ALLOCATE( t_surf_h_1(1:surf_usm_h%ns) )
5698	READ ( 13 ) tmp_surf_h
5699	ENDIF
5700	CALL surface_restore_elements( &
5701	t_surf_h_1, tmp_surf_h, &
5702	surf_usm_h%start_index, &
5703	start_index_on_file, &
5704	end_index_on_file, &
5705	nxlc, nysc, &
5706	nxlf, nxrf, nysf, nynf, &
5707	nys_on_file, nyn_on_file, &
5708	nxl_on_file,nxr_on_file )
5709	#endif
5710
5711	CASE ( 't_surf_v(0)' )
5712	#if defined( __nopointer )
5713	IF ( k == 1 ) THEN
5714	IF ( .NOT. ALLOCATED( t_surf_v(0)%t ) ) &
5715	ALLOCATE( t_surf_v(0)%t(1:surf_usm_v(0)%ns) )
5716	READ ( 13 ) tmp_surf_v(0)%t
5717	ENDIF
5718	CALL surface_restore_elements( &
5719	t_surf_v(0)%t, tmp_surf_v(0)%t, &
5720	surf_usm_v(0)%start_index, &
5721	start_index_on_file, &
5722	end_index_on_file, &
5723	nxlc, nysc, &
5724	nxlf, nxrf, nysf, nynf, &
5725	nys_on_file, nyn_on_file, &
5726	nxl_on_file,nxr_on_file )
5727	#else
5728	IF ( k == 1 ) THEN
5729	IF ( .NOT. ALLOCATED( t_surf_v_1(0)%t ) ) &
5730	ALLOCATE( t_surf_v_1(0)%t(1:surf_usm_v(0)%ns) )
5731	READ ( 13 ) tmp_surf_v(0)%t
5732	ENDIF
5733	CALL surface_restore_elements( &
5734	t_surf_v_1(0)%t, tmp_surf_v(0)%t, &
5735	surf_usm_v(0)%start_index, &
5736	start_index_on_file, &
5737	end_index_on_file, &
5738	nxlc, nysc, &
5739	nxlf, nxrf, nysf, nynf, &
5740	nys_on_file, nyn_on_file, &
5741	nxl_on_file,nxr_on_file )
5742	#endif
5743
5744	CASE ( 't_surf_v(1)' )
5745	#if defined( __nopointer )
5746	IF ( k == 1 ) THEN
5747	IF ( .NOT. ALLOCATED( t_surf_v(1)%t ) ) &
5748	ALLOCATE( t_surf_v(1)%t(1:surf_usm_v(1)%ns) )
5749	READ ( 13 ) tmp_surf_v(1)%t
5750	ENDIF
5751	CALL surface_restore_elements( &
5752	t_surf_v(1)%t, tmp_surf_v(1)%t, &
5753	surf_usm_v(1)%start_index, &
5754	start_index_on_file, &
5755	end_index_on_file, &
5756	nxlc, nysc, &
5757	nxlf, nxrf, nysf, nynf, &
5758	nys_on_file, nyn_on_file, &
5759	nxl_on_file,nxr_on_file )
5760	#else
5761	IF ( k == 1 ) THEN
5762	IF ( .NOT. ALLOCATED( t_surf_v_1(1)%t ) ) &
5763	ALLOCATE( t_surf_v_1(1)%t(1:surf_usm_v(1)%ns) )
5764	READ ( 13 ) tmp_surf_v(1)%t
5765	ENDIF
5766	CALL surface_restore_elements( &
5767	t_surf_v_1(1)%t, tmp_surf_v(1)%t, &
5768	surf_usm_v(1)%start_index, &
5769	start_index_on_file, &
5770	end_index_on_file, &
5771	nxlc, nysc, &
5772	nxlf, nxrf, nysf, nynf, &
5773	nys_on_file, nyn_on_file, &
5774	nxl_on_file,nxr_on_file )
5775	#endif
5776
5777	CASE ( 't_surf_v(2)' )
5778	#if defined( __nopointer )
5779	IF ( k == 1 ) THEN
5780	IF ( .NOT. ALLOCATED( t_surf_v(2)%t ) ) &
5781	ALLOCATE( t_surf_v(2)%t(1:surf_usm_v(2)%ns) )
5782	READ ( 13 ) tmp_surf_v(2)%t
5783	ENDIF
5784	CALL surface_restore_elements( &
5785	t_surf_v(2)%t, tmp_surf_v(2)%t, &
5786	surf_usm_v(2)%start_index, &
5787	start_index_on_file, &
5788	end_index_on_file, &
5789	nxlc, nysc, &
5790	nxlf, nxrf, nysf, nynf, &
5791	nys_on_file, nyn_on_file, &
5792	nxl_on_file,nxr_on_file )
5793	#else
5794	IF ( k == 1 ) THEN
5795	IF ( .NOT. ALLOCATED( t_surf_v_1(2)%t ) ) &
5796	ALLOCATE( t_surf_v_1(2)%t(1:surf_usm_v(2)%ns) )
5797	READ ( 13 ) tmp_surf_v(2)%t
5798	ENDIF
5799	CALL surface_restore_elements( &
5800	t_surf_v_1(2)%t, tmp_surf_v(2)%t, &
5801	surf_usm_v(2)%start_index, &
5802	start_index_on_file, &
5803	end_index_on_file, &
5804	nxlc, nysc, &
5805	nxlf, nxrf, nysf, nynf, &
5806	nys_on_file, nyn_on_file, &
5807	nxl_on_file,nxr_on_file )
5808	#endif
5809
5810	CASE ( 't_surf_v(3)' )
5811	#if defined( __nopointer )
5812	IF ( k == 1 ) THEN
5813	IF ( .NOT. ALLOCATED( t_surf_v(3)%t ) ) &
5814	ALLOCATE( t_surf_v(3)%t(1:surf_usm_v(3)%ns) )
5815	READ ( 13 ) tmp_surf_v(3)%t
5816	ENDIF
5817	CALL surface_restore_elements( &
5818	t_surf_v(3)%t, tmp_surf_v(3)%t, &
5819	surf_usm_v(3)%start_index, &
5820	start_index_on_file, &
5821	end_index_on_file, &
5822	nxlc, nysc, &
5823	nxlf, nxrf, nysf, nynf, &
5824	nys_on_file, nyn_on_file, &
5825	nxl_on_file,nxr_on_file )
5826	#else
5827	IF ( k == 1 ) THEN
5828	IF ( .NOT. ALLOCATED( t_surf_v_1(3)%t ) ) &
5829	ALLOCATE( t_surf_v_1(3)%t(1:surf_usm_v(3)%ns) )
5830	READ ( 13 ) tmp_surf_v(3)%t
5831	ENDIF
5832	CALL surface_restore_elements( &
5833	t_surf_v_1(3)%t, tmp_surf_v(3)%t, &
5834	surf_usm_v(3)%start_index, &
5835	start_index_on_file, &
5836	end_index_on_file, &
5837	nxlc, nysc, &
5838	nxlf, nxrf, nysf, nynf, &
5839	nys_on_file, nyn_on_file, &
5840	nxl_on_file,nxr_on_file )
5841	#endif
5842	CASE ( 't_surf_green_h' )
5843	#if defined( __nopointer )
5844	IF ( k == 1 ) THEN
5845	IF ( .NOT. ALLOCATED( t_surf_green_h ) ) &
5846	ALLOCATE( t_surf_green_h(1:surf_usm_h%ns) )
5847	READ ( 13 ) tmp_surf_green_h
5848	ENDIF
5849	CALL surface_restore_elements( &
5850	t_surf_green_h, tmp_surf_green_h, &
5851	surf_usm_h%start_index, &
5852	start_index_on_file, &
5853	end_index_on_file, &
5854	nxlc, nysc, &
5855	nxlf, nxrf, nysf, nynf, &
5856	nys_on_file, nyn_on_file, &
5857	nxl_on_file,nxr_on_file )
5858	#else
5859	IF ( k == 1 ) THEN
5860	IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) ) &
5861	ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
5862	READ ( 13 ) tmp_surf_green_h
5863	ENDIF
5864	CALL surface_restore_elements( &
5865	t_surf_green_h_1, tmp_surf_green_h, &
5866	surf_usm_h%start_index, &
5867	start_index_on_file, &
5868	end_index_on_file, &
5869	nxlc, nysc, &
5870	nxlf, nxrf, nysf, nynf, &
5871	nys_on_file, nyn_on_file, &
5872	nxl_on_file,nxr_on_file )
5873	#endif
5874
5875	CASE ( 't_surf_green_v(0)' )
5876	#if defined( __nopointer )
5877	IF ( k == 1 ) THEN
5878	IF ( .NOT. ALLOCATED( t_surf_green_v(0)%t ) ) &
5879	ALLOCATE( t_surf_green_v(0)%t(1:surf_usm_v(0)%ns) )
5880	READ ( 13 ) tmp_surf_green_v(0)%t
5881	ENDIF
5882	CALL surface_restore_elements( &
5883	t_surf_green_v(0)%t, &
5884	tmp_surf_green_v(0)%t, &
5885	surf_usm_v(0)%start_index, &
5886	start_index_on_file, &
5887	end_index_on_file, &
5888	nxlc, nysc, &
5889	nxlf, nxrf, nysf, nynf, &
5890	nys_on_file, nyn_on_file, &
5891	nxl_on_file,nxr_on_file )
5892	#else
5893	IF ( k == 1 ) THEN
5894	IF ( .NOT. ALLOCATED( t_surf_green_v_1(0)%t ) ) &
5895	ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
5896	READ ( 13 ) tmp_surf_green_v(0)%t
5897	ENDIF
5898	CALL surface_restore_elements( &
5899	t_surf_green_v_1(0)%t, &
5900	tmp_surf_green_v(0)%t, &
5901	surf_usm_v(0)%start_index, &
5902	start_index_on_file, &
5903	end_index_on_file, &
5904	nxlc, nysc, &
5905	nxlf, nxrf, nysf, nynf, &
5906	nys_on_file, nyn_on_file, &
5907	nxl_on_file,nxr_on_file )
5908	#endif
5909
5910	CASE ( 't_surf_green_v(1)' )
5911	#if defined( __nopointer )
5912	IF ( k == 1 ) THEN
5913	IF ( .NOT. ALLOCATED( t_surf_green_v(1)%t ) ) &
5914	ALLOCATE( t_surf_green_v(1)%t(1:surf_usm_v(1)%ns) )
5915	READ ( 13 ) tmp_surf_green_v(1)%t
5916	ENDIF
5917	CALL surface_restore_elements( &
5918	t_surf_green_v(1)%t, &
5919	tmp_surf_green_v(1)%t, &
5920	surf_usm_v(1)%start_index, &
5921	start_index_on_file, &
5922	end_index_on_file, &
5923	nxlc, nysc, &
5924	nxlf, nxrf, nysf, nynf, &
5925	nys_on_file, nyn_on_file, &
5926	nxl_on_file,nxr_on_file )
5927	#else
5928	IF ( k == 1 ) THEN
5929	IF ( .NOT. ALLOCATED( t_surf_green_v_1(1)%t ) ) &
5930	ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
5931	READ ( 13 ) tmp_surf_green_v(1)%t
5932	ENDIF
5933	CALL surface_restore_elements( &
5934	t_surf_green_v_1(1)%t, &
5935	tmp_surf_green_v(1)%t, &
5936	surf_usm_v(1)%start_index, &
5937	start_index_on_file, &
5938	end_index_on_file, &
5939	nxlc, nysc, &
5940	nxlf, nxrf, nysf, nynf, &
5941	nys_on_file, nyn_on_file, &
5942	nxl_on_file,nxr_on_file )
5943	#endif
5944
5945	CASE ( 't_surf_green_v(2)' )
5946	#if defined( __nopointer )
5947	IF ( k == 1 ) THEN
5948	IF ( .NOT. ALLOCATED( t_surf_green_v(2)%t ) ) &
5949	ALLOCATE( t_surf_green_v(2)%t(1:surf_usm_v(2)%ns) )
5950	READ ( 13 ) tmp_surf_green_v(2)%t
5951	ENDIF
5952	CALL surface_restore_elements( &
5953	t_surf_green_v(2)%t, &
5954	tmp_surf_green_v(2)%t, &
5955	surf_usm_v(2)%start_index, &
5956	start_index_on_file, &
5957	end_index_on_file, &
5958	nxlc, nysc, &
5959	nxlf, nxrf, nysf, nynf, &
5960	nys_on_file, nyn_on_file, &
5961	nxl_on_file,nxr_on_file )
5962	#else
5963	IF ( k == 1 ) THEN
5964	IF ( .NOT. ALLOCATED( t_surf_green_v_1(2)%t ) ) &
5965	ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
5966	READ ( 13 ) tmp_surf_green_v(2)%t
5967	ENDIF
5968	CALL surface_restore_elements( &
5969	t_surf_green_v_1(2)%t, &
5970	tmp_surf_green_v(2)%t, &
5971	surf_usm_v(2)%start_index, &
5972	start_index_on_file, &
5973	end_index_on_file, &
5974	nxlc, nysc, &
5975	nxlf, nxrf, nysf, nynf, &
5976	nys_on_file, nyn_on_file, &
5977	nxl_on_file,nxr_on_file )
5978	#endif
5979
5980	CASE ( 't_surf_green_v(3)' )
5981	#if defined( __nopointer )
5982	IF ( k == 1 ) THEN
5983	IF ( .NOT. ALLOCATED( t_surf_green_v(3)%t ) ) &
5984	ALLOCATE( t_surf_green_v(3)%t(1:surf_usm_v(3)%ns) )
5985	READ ( 13 ) tmp_surf_green_v(3)%t
5986	ENDIF
5987	CALL surface_restore_elements( &
5988	t_surf_green_v(3)%t, &
5989	tmp_surf_green_v(3)%t, &
5990	surf_usm_v(3)%start_index, &
5991	start_index_on_file, &
5992	end_index_on_file, &
5993	nxlc, nysc, &
5994	nxlf, nxrf, nysf, nynf, &
5995	nys_on_file, nyn_on_file, &
5996	nxl_on_file,nxr_on_file )
5997	#else
5998	IF ( k == 1 ) THEN
5999	IF ( .NOT. ALLOCATED( t_surf_green_v_1(3)%t ) ) &
6000	ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
6001	READ ( 13 ) tmp_surf_green_v(3)%t
6002	ENDIF
6003	CALL surface_restore_elements( &
6004	t_surf_green_v_1(3)%t, &
6005	tmp_surf_green_v(3)%t, &
6006	surf_usm_v(3)%start_index, &
6007	start_index_on_file, &
6008	end_index_on_file, &
6009	nxlc, nysc, &
6010	nxlf, nxrf, nysf, nynf, &
6011	nys_on_file, nyn_on_file, &
6012	nxl_on_file,nxr_on_file )
6013	#endif
6014	CASE ( 't_surf_window_h' )
6015	#if defined( __nopointer )
6016	IF ( k == 1 ) THEN
6017	IF ( .NOT. ALLOCATED( t_surf_window_h ) ) &
6018	ALLOCATE( t_surf_window_h(1:surf_usm_h%ns) )
6019	READ ( 13 ) tmp_surf_window_h
6020	ENDIF
6021	CALL surface_restore_elements( &
6022	t_surf_window_h, tmp_surf_window_h, &
6023	surf_usm_h%start_index, &
6024	start_index_on_file, &
6025	end_index_on_file, &
6026	nxlc, nysc, &
6027	nxlf, nxrf, nysf, nynf, &
6028	nys_on_file, nyn_on_file, &
6029	nxl_on_file,nxr_on_file )
6030	#else
6031	IF ( k == 1 ) THEN
6032	IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) ) &
6033	ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
6034	READ ( 13 ) tmp_surf_window_h
6035	ENDIF
6036	CALL surface_restore_elements( &
6037	t_surf_window_h_1, &
6038	tmp_surf_window_h, &
6039	surf_usm_h%start_index, &
6040	start_index_on_file, &
6041	end_index_on_file, &
6042	nxlc, nysc, &
6043	nxlf, nxrf, nysf, nynf, &
6044	nys_on_file, nyn_on_file, &
6045	nxl_on_file,nxr_on_file )
6046	#endif
6047
6048	CASE ( 't_surf_window_v(0)' )
6049	#if defined( __nopointer )
6050	IF ( k == 1 ) THEN
6051	IF ( .NOT. ALLOCATED( t_surf_window_v(0)%t ) ) &
6052	ALLOCATE( t_surf_window_v(0)%t(1:surf_usm_v(0)%ns) )
6053	READ ( 13 ) tmp_surf_window_v(0)%t
6054	ENDIF
6055	CALL surface_restore_elements( &
6056	t_surf_window_v(0)%t, &
6057	tmp_surf_window_v(0)%t, &
6058	surf_usm_v(0)%start_index, &
6059	start_index_on_file, &
6060	end_index_on_file, &
6061	nxlc, nysc, &
6062	nxlf, nxrf, nysf, nynf, &
6063	nys_on_file, nyn_on_file, &
6064	nxl_on_file,nxr_on_file )
6065	#else
6066	IF ( k == 1 ) THEN
6067	IF ( .NOT. ALLOCATED( t_surf_window_v_1(0)%t ) ) &
6068	ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
6069	READ ( 13 ) tmp_surf_window_v(0)%t
6070	ENDIF
6071	CALL surface_restore_elements( &
6072	t_surf_window_v_1(0)%t, &
6073	tmp_surf_window_v(0)%t, &
6074	surf_usm_v(0)%start_index, &
6075	start_index_on_file, &
6076	end_index_on_file, &
6077	nxlc, nysc, &
6078	nxlf, nxrf, nysf, nynf, &
6079	nys_on_file, nyn_on_file, &
6080	nxl_on_file,nxr_on_file )
6081	#endif
6082
6083	CASE ( 't_surf_window_v(1)' )
6084	#if defined( __nopointer )
6085	IF ( k == 1 ) THEN
6086	IF ( .NOT. ALLOCATED( t_surf_window_v(1)%t ) ) &
6087	ALLOCATE( t_surf_window_v(1)%t(1:surf_usm_v(1)%ns) )
6088	READ ( 13 ) tmp_surf_window_v(1)%t
6089	ENDIF
6090	CALL surface_restore_elements( &
6091	t_surf_window_v(1)%t, &
6092	tmp_surf_window_v(1)%t, &
6093	surf_usm_v(1)%start_index, &
6094	start_index_on_file, &
6095	end_index_on_file, &
6096	nxlc, nysc, &
6097	nxlf, nxrf, nysf, nynf, &
6098	nys_on_file, nyn_on_file, &
6099	nxl_on_file,nxr_on_file )
6100	#else
6101	IF ( k == 1 ) THEN
6102	IF ( .NOT. ALLOCATED( t_surf_window_v_1(1)%t ) ) &
6103	ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
6104	READ ( 13 ) tmp_surf_window_v(1)%t
6105	ENDIF
6106	CALL surface_restore_elements( &
6107	t_surf_window_v_1(1)%t, &
6108	tmp_surf_window_v(1)%t, &
6109	surf_usm_v(1)%start_index, &
6110	start_index_on_file, &
6111	end_index_on_file, &
6112	nxlc, nysc, &
6113	nxlf, nxrf, nysf, nynf, &
6114	nys_on_file, nyn_on_file, &
6115	nxl_on_file,nxr_on_file )
6116	#endif
6117
6118	CASE ( 't_surf_window_v(2)' )
6119	#if defined( __nopointer )
6120	IF ( k == 1 ) THEN
6121	IF ( .NOT. ALLOCATED( t_surf_window_v(2)%t ) ) &
6122	ALLOCATE( t_surf_window_v(2)%t(1:surf_usm_v(2)%ns) )
6123	READ ( 13 ) tmp_surf_window_v(2)%t
6124	ENDIF
6125	CALL surface_restore_elements( &
6126	t_surf_window_v(2)%t, &
6127	tmp_surf_window_v(2)%t, &
6128	surf_usm_v(2)%start_index, &
6129	start_index_on_file, &
6130	end_index_on_file, &
6131	nxlc, nysc, &
6132	nxlf, nxrf, nysf, nynf, &
6133	nys_on_file, nyn_on_file, &
6134	nxl_on_file,nxr_on_file )
6135	#else
6136	IF ( k == 1 ) THEN
6137	IF ( .NOT. ALLOCATED( t_surf_window_v_1(2)%t ) ) &
6138	ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
6139	READ ( 13 ) tmp_surf_window_v(2)%t
6140	ENDIF
6141	CALL surface_restore_elements( &
6142	t_surf_window_v_1(2)%t, &
6143	tmp_surf_window_v(2)%t, &
6144	surf_usm_v(2)%start_index, &
6145	start_index_on_file, &
6146	end_index_on_file, &
6147	nxlc, nysc, &
6148	nxlf, nxrf, nysf, nynf, &
6149	nys_on_file, nyn_on_file, &
6150	nxl_on_file,nxr_on_file )
6151	#endif
6152
6153	CASE ( 't_surf_window_v(3)' )
6154	#if defined( __nopointer )
6155	IF ( k == 1 ) THEN
6156	IF ( .NOT. ALLOCATED( t_surf_window_v(3)%t ) ) &
6157	ALLOCATE( t_surf_window_v(3)%t(1:surf_usm_v(3)%ns) )
6158	READ ( 13 ) tmp_surf_window_v(3)%t
6159	ENDIF
6160	CALL surface_restore_elements( &
6161	t_surf_window_v(3)%t, &
6162	tmp_surf_window_v(3)%t, &
6163	surf_usm_v(3)%start_index, &
6164	start_index_on_file, &
6165	end_index_on_file, &
6166	nxlc, nysc, &
6167	nxlf, nxrf, nysf, nynf, &
6168	nys_on_file, nyn_on_file, &
6169	nxl_on_file,nxr_on_file )
6170	#else
6171	IF ( k == 1 ) THEN
6172	IF ( .NOT. ALLOCATED( t_surf_window_v_1(3)%t ) ) &
6173	ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
6174	READ ( 13 ) tmp_surf_window_v(3)%t
6175	ENDIF
6176	CALL surface_restore_elements( &
6177	t_surf_window_v_1(3)%t, &
6178	tmp_surf_window_v(3)%t, &
6179	surf_usm_v(3)%start_index, &
6180	start_index_on_file, &
6181	end_index_on_file, &
6182	nxlc, nysc, &
6183	nxlf, nxrf, nysf, nynf, &
6184	nys_on_file, nyn_on_file, &
6185	nxl_on_file,nxr_on_file )
6186	#endif
6187	CASE ( 't_wall_h' )
6188	#if defined( __nopointer )
6189	IF ( k == 1 ) THEN
6190	IF ( .NOT. ALLOCATED( t_wall_h ) ) &
6191	ALLOCATE( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
6192	READ ( 13 ) tmp_wall_h
6193	ENDIF
6194	CALL surface_restore_elements( &
6195	t_wall_h, tmp_wall_h, &
6196	surf_usm_h%start_index, &
6197	start_index_on_file, &
6198	end_index_on_file, &
6199	nxlc, nysc, &
6200	nxlf, nxrf, nysf, nynf, &
6201	nys_on_file, nyn_on_file, &
6202	nxl_on_file,nxr_on_file )
6203	#else
6204	IF ( k == 1 ) THEN
6205	IF ( .NOT. ALLOCATED( t_wall_h_1 ) ) &
6206	ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1, &
6207	1:surf_usm_h%ns) )
6208	READ ( 13 ) tmp_wall_h
6209	ENDIF
6210	CALL surface_restore_elements( &
6211	t_wall_h_1, tmp_wall_h, &
6212	surf_usm_h%start_index, &
6213	start_index_on_file, &
6214	end_index_on_file, &
6215	nxlc, nysc, &
6216	nxlf, nxrf, nysf, nynf, &
6217	nys_on_file, nyn_on_file, &
6218	nxl_on_file,nxr_on_file )
6219	#endif
6220	CASE ( 't_wall_v(0)' )
6221	#if defined( __nopointer )
6222	IF ( k == 1 ) THEN
6223	IF ( .NOT. ALLOCATED( t_wall_v(0)%t ) ) &
6224	ALLOCATE( t_wall_v(0)%t(nzb_wall:nzt_wall+1, &
6225	1:surf_usm_v(0)%ns) )
6226	READ ( 13 ) tmp_wall_v(0)%t
6227	ENDIF
6228	CALL surface_restore_elements( &
6229	t_wall_v(0)%t, tmp_wall_v(0)%t, &
6230	surf_usm_v(0)%start_index, &
6231	start_index_on_file, &
6232	end_index_on_file, &
6233	nxlc, nysc, &
6234	nxlf, nxrf, nysf, nynf, &
6235	nys_on_file, nyn_on_file, &
6236	nxl_on_file,nxr_on_file )
6237	#else
6238	IF ( k == 1 ) THEN
6239	IF ( .NOT. ALLOCATED( t_wall_v_1(0)%t ) ) &
6240	ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1, &
6241	1:surf_usm_v(0)%ns) )
6242	READ ( 13 ) tmp_wall_v(0)%t
6243	ENDIF
6244	CALL surface_restore_elements( &
6245	t_wall_v_1(0)%t, tmp_wall_v(0)%t, &
6246	surf_usm_v(0)%start_index, &
6247	start_index_on_file, &
6248	end_index_on_file, &
6249	nxlc, nysc, &
6250	nxlf, nxrf, nysf, nynf, &
6251	nys_on_file, nyn_on_file, &
6252	nxl_on_file,nxr_on_file )
6253	#endif
6254	CASE ( 't_wall_v(1)' )
6255	#if defined( __nopointer )
6256	IF ( k == 1 ) THEN
6257	IF ( .NOT. ALLOCATED( t_wall_v(1)%t ) ) &
6258	ALLOCATE( t_wall_v(1)%t(nzb_wall:nzt_wall+1, &
6259	1:surf_usm_v(1)%ns) )
6260	READ ( 13 ) tmp_wall_v(1)%t
6261	ENDIF
6262	CALL surface_restore_elements( &
6263	t_wall_v(1)%t, tmp_wall_v(1)%t, &
6264	surf_usm_v(1)%start_index, &
6265	start_index_on_file, &
6266	end_index_on_file , &
6267	nxlc, nysc, &
6268	nys_on_file, nyn_on_file, &
6269	nxl_on_file, nxr_on_file )
6270	#else
6271	IF ( k == 1 ) THEN
6272	IF ( .NOT. ALLOCATED( t_wall_v_1(1)%t ) ) &
6273	ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1, &
6274	1:surf_usm_v(1)%ns) )
6275	READ ( 13 ) tmp_wall_v(1)%t
6276	ENDIF
6277	CALL surface_restore_elements( &
6278	t_wall_v_1(1)%t, tmp_wall_v(1)%t, &
6279	surf_usm_v(1)%start_index, &
6280	start_index_on_file, &
6281	end_index_on_file, &
6282	nxlc, nysc, &
6283	nxlf, nxrf, nysf, nynf, &
6284	nys_on_file, nyn_on_file, &
6285	nxl_on_file,nxr_on_file )
6286	#endif
6287	CASE ( 't_wall_v(2)' )
6288	#if defined( __nopointer )
6289	IF ( k == 1 ) THEN
6290	IF ( .NOT. ALLOCATED( t_wall_v(2)%t ) ) &
6291	ALLOCATE( t_wall_v(2)%t(nzb_wall:nzt_wall+1, &
6292	1:surf_usm_v(2)%ns) )
6293	READ ( 13 ) tmp_wall_v(2)%t
6294	ENDIF
6295	CALL surface_restore_elements( &
6296	t_wall_v(2)%t, tmp_wall_v(2)%t, &
6297	surf_usm_v(2)%start_index, &
6298	start_index_on_file, &
6299	end_index_on_file, &
6300	nxlc, nysc, &
6301	nxlf, nxrf, nysf, nynf, &
6302	nys_on_file, nyn_on_file, &
6303	nxl_on_file,nxr_on_file )
6304	#else
6305	IF ( k == 1 ) THEN
6306	IF ( .NOT. ALLOCATED( t_wall_v_1(2)%t ) ) &
6307	ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1, &
6308	1:surf_usm_v(2)%ns) )
6309	READ ( 13 ) tmp_wall_v(2)%t
6310	ENDIF
6311	CALL surface_restore_elements( &
6312	t_wall_v_1(2)%t, tmp_wall_v(2)%t, &
6313	surf_usm_v(2)%start_index, &
6314	start_index_on_file, &
6315	end_index_on_file , &
6316	nxlc, nysc, &
6317	nxlf, nxrf, nysf, nynf, &
6318	nys_on_file, nyn_on_file, &
6319	nxl_on_file,nxr_on_file )
6320	#endif
6321	CASE ( 't_wall_v(3)' )
6322	#if defined( __nopointer )
6323	IF ( k == 1 ) THEN
6324	IF ( .NOT. ALLOCATED( t_wall_v(3)%t ) ) &
6325	ALLOCATE( t_wall_v(3)%t(nzb_wall:nzt_wall+1, &
6326	1:surf_usm_v(3)%ns) )
6327	READ ( 13 ) tmp_wall_v(3)%t
6328	ENDIF
6329	CALL surface_restore_elements( &
6330	t_wall_v(3)%t, tmp_wall_v(3)%t, &
6331	surf_usm_v(3)%start_index, &
6332	start_index_on_file, &
6333	end_index_on_file, &
6334	nxlc, nysc, &
6335	nxlf, nxrf, nysf, nynf, &
6336	nys_on_file, nyn_on_file, &
6337	nxl_on_file,nxr_on_file )
6338	#else
6339	IF ( k == 1 ) THEN
6340	IF ( .NOT. ALLOCATED( t_wall_v_1(3)%t ) ) &
6341	ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1, &
6342	1:surf_usm_v(3)%ns) )
6343	READ ( 13 ) tmp_wall_v(3)%t
6344	ENDIF
6345	CALL surface_restore_elements( &
6346	t_wall_v_1(3)%t, tmp_wall_v(3)%t, &
6347	surf_usm_v(3)%start_index, &
6348	start_index_on_file, &
6349	end_index_on_file, &
6350	nxlc, nysc, &
6351	nxlf, nxrf, nysf, nynf, &
6352	nys_on_file, nyn_on_file, &
6353	nxl_on_file,nxr_on_file )
6354	#endif
6355	CASE ( 't_green_h' )
6356	#if defined( __nopointer )
6357	IF ( k == 1 ) THEN
6358	IF ( .NOT. ALLOCATED( t_green_h ) ) &
6359	ALLOCATE( t_green_h(nzb_wall:nzt_wall+1, &
6360	1:surf_usm_h%ns) )
6361	READ ( 13 ) tmp_green_h
6362	ENDIF
6363	CALL surface_restore_elements( &
6364	t_green_h, tmp_green_h, &
6365	surf_usm_h%start_index, &
6366	start_index_on_file, &
6367	end_index_on_file, &
6368	nxlc, nysc, &
6369	nxlf, nxrf, nysf, nynf, &
6370	nys_on_file, nyn_on_file, &
6371	nxl_on_file,nxr_on_file )
6372	#else
6373	IF ( k == 1 ) THEN
6374	IF ( .NOT. ALLOCATED( t_green_h_1 ) ) &
6375	ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1, &
6376	1:surf_usm_h%ns) )
6377	READ ( 13 ) tmp_green_h
6378	ENDIF
6379	CALL surface_restore_elements( &
6380	t_green_h_1, tmp_green_h, &
6381	surf_usm_h%start_index, &
6382	start_index_on_file, &
6383	end_index_on_file, &
6384	nxlc, nysc, &
6385	nxlf, nxrf, nysf, nynf, &
6386	nys_on_file, nyn_on_file, &
6387	nxl_on_file,nxr_on_file )
6388	#endif
6389	CASE ( 't_green_v(0)' )
6390	#if defined( __nopointer )
6391	IF ( k == 1 ) THEN
6392	IF ( .NOT. ALLOCATED( t_green_v(0)%t ) ) &
6393	ALLOCATE( t_green_v(0)%t(nzb_wall:nzt_wall+1, &
6394	1:surf_usm_v(0)%ns) )
6395	READ ( 13 ) tmp_green_v(0)%t
6396	ENDIF
6397	CALL surface_restore_elements( &
6398	t_green_v(0)%t, tmp_green_v(0)%t, &
6399	surf_usm_v(0)%start_index, &
6400	start_index_on_file, &
6401	end_index_on_file, &
6402	nxlc, nysc, &
6403	nxlf, nxrf, nysf, nynf, &
6404	nys_on_file, nyn_on_file, &
6405	nxl_on_file,nxr_on_file )
6406	#else
6407	IF ( k == 1 ) THEN
6408	IF ( .NOT. ALLOCATED( t_green_v_1(0)%t ) ) &
6409	ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1, &
6410	1:surf_usm_v(0)%ns) )
6411	READ ( 13 ) tmp_green_v(0)%t
6412	ENDIF
6413	CALL surface_restore_elements( &
6414	t_green_v_1(0)%t, tmp_green_v(0)%t, &
6415	surf_usm_v(0)%start_index, &
6416	start_index_on_file, &
6417	end_index_on_file, &
6418	nxlc, nysc, &
6419	nxlf, nxrf, nysf, nynf, &
6420	nys_on_file, nyn_on_file, &
6421	nxl_on_file,nxr_on_file )
6422	#endif
6423	CASE ( 't_green_v(1)' )
6424	#if defined( __nopointer )
6425	IF ( k == 1 ) THEN
6426	IF ( .NOT. ALLOCATED( t_green_v(1)%t ) ) &
6427	ALLOCATE( t_green_v(1)%t(nzb_wall:nzt_wall+1, &
6428	1:surf_usm_v(1)%ns) )
6429	READ ( 13 ) tmp_green_v(1)%t
6430	ENDIF
6431	CALL surface_restore_elements( &
6432	t_green_v(1)%t, tmp_green_v(1)%t, &
6433	surf_usm_v(1)%start_index, &
6434	start_index_on_file, &
6435	end_index_on_file , &
6436	nxlc, nysc, &
6437	nys_on_file, nyn_on_file, &
6438	nxl_on_file,nxr_on_file )
6439	#else
6440	IF ( k == 1 ) THEN
6441	IF ( .NOT. ALLOCATED( t_green_v_1(1)%t ) ) &
6442	ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1, &
6443	1:surf_usm_v(1)%ns) )
6444	READ ( 13 ) tmp_green_v(1)%t
6445	ENDIF
6446	CALL surface_restore_elements( &
6447	t_green_v_1(1)%t, tmp_green_v(1)%t, &
6448	surf_usm_v(1)%start_index, &
6449	start_index_on_file, &
6450	end_index_on_file, &
6451	nxlc, nysc, &
6452	nxlf, nxrf, nysf, nynf, &
6453	nys_on_file, nyn_on_file, &
6454	nxl_on_file,nxr_on_file )
6455	#endif
6456	CASE ( 't_green_v(2)' )
6457	#if defined( __nopointer )
6458	IF ( k == 1 ) THEN
6459	IF ( .NOT. ALLOCATED( t_green_v(2)%t ) ) &
6460	ALLOCATE( t_green_v(2)%t(nzb_wall:nzt_wall+1, &
6461	1:surf_usm_v(2)%ns) )
6462	READ ( 13 ) tmp_green_v(2)%t
6463	ENDIF
6464	CALL surface_restore_elements( &
6465	t_green_v(2)%t, tmp_green_v(2)%t, &
6466	surf_usm_v(2)%start_index, &
6467	start_index_on_file, &
6468	end_index_on_file, &
6469	nxlc, nysc, &
6470	nxlf, nxrf, nysf, nynf, &
6471	nys_on_file, nyn_on_file, &
6472	nxl_on_file,nxr_on_file )
6473	#else
6474	IF ( k == 1 ) THEN
6475	IF ( .NOT. ALLOCATED( t_green_v_1(2)%t ) ) &
6476	ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1, &
6477	1:surf_usm_v(2)%ns) )
6478	READ ( 13 ) tmp_green_v(2)%t
6479	ENDIF
6480	CALL surface_restore_elements( &
6481	t_green_v_1(2)%t, tmp_green_v(2)%t, &
6482	surf_usm_v(2)%start_index, &
6483	start_index_on_file, &
6484	end_index_on_file , &
6485	nxlc, nysc, &
6486	nxlf, nxrf, nysf, nynf, &
6487	nys_on_file, nyn_on_file, &
6488	nxl_on_file,nxr_on_file )
6489	#endif
6490	CASE ( 't_green_v(3)' )
6491	#if defined( __nopointer )
6492	IF ( k == 1 ) THEN
6493	IF ( .NOT. ALLOCATED( t_green_v(3)%t ) ) &
6494	ALLOCATE( t_green_v(3)%t(nzb_wall:nzt_wall+1, &
6495	1:surf_usm_v(3)%ns) )
6496	READ ( 13 ) tmp_green_v(3)%t
6497	ENDIF
6498	CALL surface_restore_elements( &
6499	t_green_v(3)%t, tmp_green_v(3)%t, &
6500	surf_usm_v(3)%start_index, &
6501	start_index_on_file, &
6502	end_index_on_file, &
6503	nxlc, nysc, &
6504	nxlf, nxrf, nysf, nynf, &
6505	nys_on_file, nyn_on_file, &
6506	nxl_on_file,nxr_on_file )
6507	#else
6508	IF ( k == 1 ) THEN
6509	IF ( .NOT. ALLOCATED( t_green_v_1(3)%t ) ) &
6510	ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1, &
6511	1:surf_usm_v(3)%ns) )
6512	READ ( 13 ) tmp_green_v(3)%t
6513	ENDIF
6514	CALL surface_restore_elements( &
6515	t_green_v_1(3)%t, tmp_green_v(3)%t, &
6516	surf_usm_v(3)%start_index, &
6517	start_index_on_file, &
6518	end_index_on_file, &
6519	nxlc, nysc, &
6520	nxlf, nxrf, nysf, nynf, &
6521	nys_on_file, nyn_on_file, &
6522	nxl_on_file,nxr_on_file )
6523	#endif
6524	CASE ( 't_window_h' )
6525	#if defined( __nopointer )
6526	IF ( k == 1 ) THEN
6527	IF ( .NOT. ALLOCATED( t_window_h ) ) &
6528	ALLOCATE( t_window_h(nzb_wall:nzt_wall+1, &
6529	1:surf_usm_h%ns) )
6530	READ ( 13 ) tmp_window_h
6531	ENDIF
6532	CALL surface_restore_elements( &
6533	t_window_h, tmp_window_h, &
6534	surf_usm_h%start_index, &
6535	start_index_on_file, &
6536	end_index_on_file, &
6537	nxlc, nysc, &
6538	nxlf, nxrf, nysf, nynf, &
6539	nys_on_file, nyn_on_file, &
6540	nxl_on_file,nxr_on_file )
6541	#else
6542	IF ( k == 1 ) THEN
6543	IF ( .NOT. ALLOCATED( t_window_h_1 ) ) &
6544	ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1, &
6545	1:surf_usm_h%ns) )
6546	READ ( 13 ) tmp_window_h
6547	ENDIF
6548	CALL surface_restore_elements( &
6549	t_window_h_1, tmp_window_h, &
6550	surf_usm_h%start_index, &
6551	start_index_on_file, &
6552	end_index_on_file, &
6553	nxlc, nysc, &
6554	nxlf, nxrf, nysf, nynf, &
6555	nys_on_file, nyn_on_file, &
6556	nxl_on_file, nxr_on_file )
6557	#endif
6558	CASE ( 't_window_v(0)' )
6559	#if defined( __nopointer )
6560	IF ( k == 1 ) THEN
6561	IF ( .NOT. ALLOCATED( t_window_v(0)%t ) ) &
6562	ALLOCATE( t_window_v(0)%t(nzb_wall:nzt_wall+1, &
6563	1:surf_usm_v(0)%ns) )
6564	READ ( 13 ) tmp_window_v(0)%t
6565	ENDIF
6566	CALL surface_restore_elements( &
6567	t_window_v(0)%t, tmp_window_v(0)%t, &
6568	surf_usm_v(0)%start_index, &
6569	start_index_on_file, &
6570	end_index_on_file, &
6571	nxlc, nysc, &
6572	nxlf, nxrf, nysf, nynf, &
6573	nys_on_file, nyn_on_file, &
6574	nxl_on_file, nxr_on_file )
6575	#else
6576	IF ( k == 1 ) THEN
6577	IF ( .NOT. ALLOCATED( t_window_v_1(0)%t ) ) &
6578	ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1, &
6579	1:surf_usm_v(0)%ns) )
6580	READ ( 13 ) tmp_window_v(0)%t
6581	ENDIF
6582	CALL surface_restore_elements( &
6583	t_window_v_1(0)%t, &
6584	tmp_window_v(0)%t, &
6585	surf_usm_v(0)%start_index, &
6586	start_index_on_file, &
6587	end_index_on_file, &
6588	nxlc, nysc, &
6589	nxlf, nxrf, nysf, nynf, &
6590	nys_on_file, nyn_on_file, &
6591	nxl_on_file,nxr_on_file )
6592	#endif
6593	CASE ( 't_window_v(1)' )
6594	#if defined( __nopointer )
6595	IF ( k == 1 ) THEN
6596	IF ( .NOT. ALLOCATED( t_window_v(1)%t ) ) &
6597	ALLOCATE( t_window_v(1)%t(nzb_wall:nzt_wall+1, &
6598	1:surf_usm_v(1)%ns) )
6599	READ ( 13 ) tmp_window_v(1)%t
6600	ENDIF
6601	CALL surface_restore_elements( &
6602	t_window_v(1)%t, tmp_window_v(1)%t, &
6603	surf_usm_v(1)%start_index, &
6604	start_index_on_file, &
6605	end_index_on_file , &
6606	nxlc, nysc, &
6607	nys_on_file, nyn_on_file, &
6608	nxl_on_file, nxr_on_file )
6609	#else
6610	IF ( k == 1 ) THEN
6611	IF ( .NOT. ALLOCATED( t_window_v_1(1)%t ) ) &
6612	ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1, &
6613	1:surf_usm_v(1)%ns) )
6614	READ ( 13 ) tmp_window_v(1)%t
6615	ENDIF
6616	CALL surface_restore_elements( &
6617	t_window_v_1(1)%t, &
6618	tmp_window_v(1)%t, &
6619	surf_usm_v(1)%start_index, &
6620	start_index_on_file, &
6621	end_index_on_file, &
6622	nxlc, nysc, &
6623	nxlf, nxrf, nysf, nynf, &
6624	nys_on_file, nyn_on_file, &
6625	nxl_on_file,nxr_on_file )
6626	#endif
6627	CASE ( 't_window_v(2)' )
6628	#if defined( __nopointer )
6629	IF ( k == 1 ) THEN
6630	IF ( .NOT. ALLOCATED( t_window_v(2)%t ) ) &
6631	ALLOCATE( t_window_v(2)%t(nzb_wall:nzt_wall+1, &
6632	1:surf_usm_v(2)%ns) )
6633	READ ( 13 ) tmp_window_v(2)%t
6634	ENDIF
6635	CALL surface_restore_elements( &
6636	t_window_v(2)%t, tmp_window_v(2)%t, &
6637	surf_usm_v(2)%start_index, &
6638	start_index_on_file, &
6639	end_index_on_file, &
6640	nxlc, nysc, &
6641	nxlf, nxrf, nysf, nynf, &
6642	nys_on_file, nyn_on_file, &
6643	nxl_on_file,nxr_on_file )
6644	#else
6645	IF ( k == 1 ) THEN
6646	IF ( .NOT. ALLOCATED( t_window_v_1(2)%t ) ) &
6647	ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1, &
6648	1:surf_usm_v(2)%ns) )
6649	READ ( 13 ) tmp_window_v(2)%t
6650	ENDIF
6651	CALL surface_restore_elements( &
6652	t_window_v_1(2)%t, &
6653	tmp_window_v(2)%t, &
6654	surf_usm_v(2)%start_index, &
6655	start_index_on_file, &
6656	end_index_on_file , &
6657	nxlc, nysc, &
6658	nxlf, nxrf, nysf, nynf, &
6659	nys_on_file, nyn_on_file, &
6660	nxl_on_file,nxr_on_file )
6661	#endif
6662	CASE ( 't_window_v(3)' )
6663	#if defined( __nopointer )
6664	IF ( k == 1 ) THEN
6665	IF ( .NOT. ALLOCATED( t_window_v(3)%t ) ) &
6666	ALLOCATE( t_window_v(3)%t(nzb_wall:nzt_wall+1, &
6667	1:surf_usm_v(3)%ns) )
6668	READ ( 13 ) tmp_window_v(3)%t
6669	ENDIF
6670	CALL surface_restore_elements( &
6671	t_window_v(3)%t, tmp_window_v(3)%t, &
6672	surf_usm_v(3)%start_index, &
6673	start_index_on_file, &
6674	end_index_on_file, &
6675	nxlc, nysc, &
6676	nxlf, nxrf, nysf, nynf, &
6677	nys_on_file, nyn_on_file, &
6678	nxl_on_file,nxr_on_file )
6679	#else
6680	IF ( k == 1 ) THEN
6681	IF ( .NOT. ALLOCATED( t_window_v_1(3)%t ) ) &
6682	ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
6683	READ ( 13 ) tmp_window_v(3)%t
6684	ENDIF
6685	CALL surface_restore_elements( &
6686	t_window_v_1(3)%t, &
6687	tmp_window_v(3)%t, &
6688	surf_usm_v(3)%start_index, &
6689	start_index_on_file, &
6690	end_index_on_file, &
6691	nxlc, nysc, &
6692	nxlf, nxrf, nysf, nynf, &
6693	nys_on_file, nyn_on_file, &
6694	nxl_on_file,nxr_on_file )
6695	#endif
6696	CASE DEFAULT
6697
6698	found = .FALSE.
6699
6700	END SELECT
6701
6702
6703	END SUBROUTINE usm_rrd_local
6704
6705
6706
6707	!------------------------------------------------------------------------------!
6708	! Description:
6709	! ------------
6710	!
6711	!> This subroutine reads walls, roofs and land categories and it parameters
6712	!> from input files.
6713	!------------------------------------------------------------------------------!
6714	SUBROUTINE usm_read_urban_surface_types
6715
6716	USE netcdf_data_input_mod, &
6717	ONLY: building_pars_f, building_type_f
6718
6719	IMPLICIT NONE
6720
6721	CHARACTER(12) :: wtn
6722	INTEGER(iwp) :: wtc
6723	REAL(wp), DIMENSION(n_surface_params) :: wtp
6724
6725	INTEGER(iwp), DIMENSION(0:17, nysg:nyng, nxlg:nxrg) :: usm_par
6726	REAL(wp), DIMENSION(1:14, nysg:nyng, nxlg:nxrg) :: usm_val
6727	INTEGER(iwp) :: k, l, d, iw, jw, kw, it, ip, ii, ij, m
6728	INTEGER(iwp) :: i, j
6729	INTEGER(iwp) :: nz, roof, dirwe, dirsn
6730	INTEGER(iwp) :: category
6731	INTEGER(iwp) :: weheight1, wecat1, snheight1, sncat1
6732	INTEGER(iwp) :: weheight2, wecat2, snheight2, sncat2
6733	INTEGER(iwp) :: weheight3, wecat3, snheight3, sncat3
6734	REAL(wp) :: height, albedo, thick
6735	REAL(wp) :: wealbedo1, wethick1, snalbedo1, snthick1
6736	REAL(wp) :: wealbedo2, wethick2, snalbedo2, snthick2
6737	REAL(wp) :: wealbedo3, wethick3, snalbedo3, snthick3
6738
6739	LOGICAL :: surfpar
6740	LOGICAL :: urbsurf
6741
6742	!
6743	!-- If building_pars or building_type are already read from static input
6744	!-- file, skip reading ASCII file.
6745	IF ( building_type_f%from_file .OR. building_pars_f%from_file ) &
6746	RETURN
6747
6748	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6749	!-- read categories of walls and their parameters
6750	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6751	DO ii = 0, io_blocks-1
6752	IF ( ii == io_group ) THEN
6753
6754	!-- open urban surface file
6755	OPEN( 151, file='SURFACE_PARAMETERS'//coupling_char, action='read', &
6756	status='old', form='formatted', err=15 )
6757	!-- first test and get n_surface_types
6758	k = 0
6759	l = 0
6760	DO
6761	l = l+1
6762	READ( 151, *, err=11, end=12 ) wtc, wtp, wtn
6763	k = k+1
6764	CYCLE
6765	11 CONTINUE
6766	ENDDO
6767	12 n_surface_types = k
6768	ALLOCATE( surface_type_names(n_surface_types) )
6769	ALLOCATE( surface_type_codes(n_surface_types) )
6770	ALLOCATE( surface_params(n_surface_params, n_surface_types) )
6771	!-- real reading
6772	rewind( 151 )
6773	k = 0
6774	DO
6775	READ( 151, *, err=13, end=14 ) wtc, wtp, wtn
6776	k = k+1
6777	surface_type_codes(k) = wtc
6778	surface_params(:,k) = wtp
6779	surface_type_names(k) = wtn
6780	CYCLE
6781	13 WRITE(6,'(i3,a,2i5)') myid, 'readparams2 error k=', k
6782	FLUSH(6)
6783	CONTINUE
6784	ENDDO
6785	14 CLOSE(151)
6786	CYCLE
6787	15 message_string = 'file SURFACE_PARAMETERS'//TRIM(coupling_char)//' does not exist'
6788	CALL message( 'usm_read_urban_surface_types', 'PA0513', 1, 2, 0, 6, 0 )
6789	ENDIF
6790	ENDDO
6791
6792	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6793	!-- read types of surfaces
6794	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6795	usm_par = 0
6796	DO ii = 0, io_blocks-1
6797	IF ( ii == io_group ) THEN
6798
6799	!
6800	!-- open csv urban surface file
6801	OPEN( 151, file='URBAN_SURFACE'//TRIM(coupling_char), action='read', &
6802	status='old', form='formatted', err=23 )
6803
6804	l = 0
6805	DO
6806	l = l+1
6807	!-- i, j, height, nz, roof, dirwe, dirsn, category, soilcat,
6808	!-- weheight1, wecat1, snheight1, sncat1, weheight2, wecat2, snheight2, sncat2,
6809	!-- weheight3, wecat3, snheight3, sncat3
6810	READ( 151, *, err=21, end=25 ) i, j, height, nz, roof, dirwe, dirsn, &
6811	category, albedo, thick, &
6812	weheight1, wecat1, wealbedo1, wethick1, &
6813	weheight2, wecat2, wealbedo2, wethick2, &
6814	weheight3, wecat3, wealbedo3, wethick3, &
6815	snheight1, sncat1, snalbedo1, snthick1, &
6816	snheight2, sncat2, snalbedo2, snthick2, &
6817	snheight3, sncat3, snalbedo3, snthick3
6818
6819	IF ( i >= nxlg .AND. i <= nxrg .AND. j >= nysg .AND. j <= nyng ) THEN
6820	!-- write integer variables into array
6821	usm_par(:,j,i) = (/1, nz, roof, dirwe, dirsn, category, &
6822	weheight1, wecat1, weheight2, wecat2, weheight3, wecat3, &
6823	snheight1, sncat1, snheight2, sncat2, snheight3, sncat3 /)
6824	!-- write real values into array
6825	usm_val(:,j,i) = (/ albedo, thick, &
6826	wealbedo1, wethick1, wealbedo2, wethick2, &
6827	wealbedo3, wethick3, snalbedo1, snthick1, &
6828	snalbedo2, snthick2, snalbedo3, snthick3 /)
6829	ENDIF
6830	CYCLE
6831	21 WRITE (message_string, "(A,I5)") 'errors in file URBAN_SURFACE'//TRIM(coupling_char)//' on line ', l
6832	CALL message( 'usm_read_urban_surface_types', 'PA0512', 0, 1, 0, 6, 0 )
6833	ENDDO
6834
6835	23 message_string = 'file URBAN_SURFACE'//TRIM(coupling_char)//' does not exist'
6836	CALL message( 'usm_read_urban_surface_types', 'PA0514', 1, 2, 0, 6, 0 )
6837
6838	25 CLOSE( 151 )
6839
6840	ENDIF
6841	#if defined( __parallel )
6842	CALL MPI_BARRIER( comm2d, ierr )
6843	#endif
6844	ENDDO
6845
6846	!
6847	!-- check completeness and formal correctness of the data
6848	DO i = nxlg, nxrg
6849	DO j = nysg, nyng
6850	IF ( usm_par(0,j,i) /= 0 .AND. ( & !< incomplete data,supply default values later
6851	usm_par(1,j,i) < nzb .OR. &
6852	usm_par(1,j,i) > nzt .OR. & !< incorrect height (nz < nzb .OR. nz > nzt)
6853	usm_par(2,j,i) < 0 .OR. &
6854	usm_par(2,j,i) > 1 .OR. & !< incorrect roof sign
6855	usm_par(3,j,i) < nzb-nzt .OR. &
6856	usm_par(3,j,i) > nzt-nzb .OR. & !< incorrect west-east wall direction sign
6857	usm_par(4,j,i) < nzb-nzt .OR. &
6858	usm_par(4,j,i) > nzt-nzb .OR. & !< incorrect south-north wall direction sign
6859	usm_par(6,j,i) < nzb .OR. &
6860	usm_par(6,j,i) > nzt .OR. & !< incorrect pedestrian level height for west-east wall
6861	usm_par(8,j,i) > nzt .OR. &
6862	usm_par(10,j,i) > nzt .OR. & !< incorrect wall or roof level height for west-east wall
6863	usm_par(12,j,i) < nzb .OR. &
6864	usm_par(12,j,i) > nzt .OR. & !< incorrect pedestrian level height for south-north wall
6865	usm_par(14,j,i) > nzt .OR. &
6866	usm_par(16,j,i) > nzt & !< incorrect wall or roof level height for south-north wall
6867	) ) THEN
6868	!-- incorrect input data
6869	WRITE (message_string, "(A,2I5)") 'missing or incorrect data in file URBAN_SURFACE'// &
6870	TRIM(coupling_char)//' for i,j=', i,j
6871	CALL message( 'usm_read_urban_surface', 'PA0504', 1, 2, 0, 6, 0 )
6872	ENDIF
6873
6874	ENDDO
6875	ENDDO
6876	!
6877	!-- Assign the surface types to the respective data type.
6878	!-- First, for horizontal upward-facing surfaces.
6879	DO m = 1, surf_usm_h%ns
6880	iw = surf_usm_h%i(m)
6881	jw = surf_usm_h%j(m)
6882	kw = surf_usm_h%k(m)
6883
6884	IF ( usm_par(5,jw,iw) == 0 ) THEN
6885	#if ! defined( __nopointer )
6886	IF ( zu(kw) >= roof_height_limit ) THEN
6887	surf_usm_h%isroof_surf(m) = .TRUE.
6888	surf_usm_h%surface_types(m) = roof_category !< default category for root surface
6889	ELSE
6890	surf_usm_h%isroof_surf(m) = .FALSE.
6891	surf_usm_h%surface_types(m) = land_category !< default category for land surface
6892	ENDIF
6893	#endif
6894	surf_usm_h%albedo(:,m) = -1.0_wp
6895	surf_usm_h%thickness_wall(m) = -1.0_wp
6896	surf_usm_h%thickness_green(m) = -1.0_wp
6897	surf_usm_h%thickness_window(m) = -1.0_wp
6898	ELSE
6899	IF ( usm_par(2,jw,iw)==0 ) THEN
6900	surf_usm_h%isroof_surf(m) = .FALSE.
6901	surf_usm_h%thickness_wall(m) = -1.0_wp
6902	surf_usm_h%thickness_window(m) = -1.0_wp
6903	surf_usm_h%thickness_green(m) = -1.0_wp
6904	ELSE
6905	surf_usm_h%isroof_surf(m) = .TRUE.
6906	surf_usm_h%thickness_wall(m) = usm_val(2,jw,iw)
6907	surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
6908	surf_usm_h%thickness_green(m) = usm_val(2,jw,iw)
6909	ENDIF
6910	surf_usm_h%surface_types(m) = usm_par(5,jw,iw)
6911	surf_usm_h%albedo(:,m) = usm_val(1,jw,iw)
6912	surf_usm_h%transmissivity(m) = 0.0_wp
6913	ENDIF
6914	!
6915	!-- Find the type position
6916	it = surf_usm_h%surface_types(m)
6917	ip = -99999
6918	DO k = 1, n_surface_types
6919	IF ( surface_type_codes(k) == it ) THEN
6920	ip = k
6921	EXIT
6922	ENDIF
6923	ENDDO
6924	IF ( ip == -99999 ) THEN
6925	!-- wall category not found
6926	WRITE (message_string, "(A,I5,A,3I5)") 'wall category ', it, &
6927	' not found for i,j,k=', iw,jw,kw
6928	CALL message( 'usm_read_urban_surface', 'PA0506', 1, 2, 0, 6, 0 )
6929	ENDIF
6930	!
6931	!-- Albedo
6932	IF ( surf_usm_h%albedo(ind_veg_wall,m) < 0.0_wp ) THEN
6933	surf_usm_h%albedo(:,m) = surface_params(ialbedo,ip)
6934	ENDIF
6935	!-- Albedo type is 0 (custom), others are replaced later
6936	surf_usm_h%albedo_type(:,m) = 0
6937	!-- Transmissivity
6938	IF ( surf_usm_h%transmissivity(m) < 0.0_wp ) THEN
6939	surf_usm_h%transmissivity(m) = 0.0_wp
6940	ENDIF
6941	!
6942	!-- emissivity of the wall
6943	surf_usm_h%emissivity(:,m) = surface_params(iemiss,ip)
6944	!
6945	!-- heat conductivity Î»S between air and wall ( W mâ2 Kâ1 )
6946	surf_usm_h%lambda_surf(m) = surface_params(ilambdas,ip)
6947	surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
6948	surf_usm_h%lambda_surf_green(m) = surface_params(ilambdas,ip)
6949	!
6950	!-- roughness length for momentum, heat and humidity
6951	surf_usm_h%z0(m) = surface_params(irough,ip)
6952	surf_usm_h%z0h(m) = surface_params(iroughh,ip)
6953	surf_usm_h%z0q(m) = surface_params(iroughh,ip)
6954	!
6955	!-- Surface skin layer heat capacity (J mâ2 Kâ1 )
6956	surf_usm_h%c_surface(m) = surface_params(icsurf,ip)
6957	surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
6958	surf_usm_h%c_surface_green(m) = surface_params(icsurf,ip)
6959	!
6960	!-- wall material parameters:
6961	!-- thickness of the wall (m)
6962	!-- missing values are replaced by default value for category
6963	IF ( surf_usm_h%thickness_wall(m) <= 0.001_wp ) THEN
6964	surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
6965	ENDIF
6966	IF ( surf_usm_h%thickness_window(m) <= 0.001_wp ) THEN
6967	surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
6968	ENDIF
6969	IF ( surf_usm_h%thickness_green(m) <= 0.001_wp ) THEN
6970	surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
6971	ENDIF
6972	!
6973	!-- volumetric heat capacity rho*C of the wall ( J mâ3 Kâ1 )
6974	surf_usm_h%rho_c_wall(:,m) = surface_params(irhoC,ip)
6975	surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
6976	surf_usm_h%rho_c_green(:,m) = surface_params(irhoC,ip)
6977	!
6978	!-- thermal conductivity Î»H of the wall (W mâ1 Kâ1 )
6979	surf_usm_h%lambda_h(:,m) = surface_params(ilambdah,ip)
6980	surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
6981	surf_usm_h%lambda_h_green(:,m) = surface_params(ilambdah,ip)
6982
6983	ENDDO
6984	!
6985	!-- For vertical surface elements ( 0 -- northward-facing, 1 -- southward-facing,
6986	!-- 2 -- eastward-facing, 3 -- westward-facing )
6987	DO l = 0, 3
6988	DO m = 1, surf_usm_v(l)%ns
6989	i = surf_usm_v(l)%i(m)
6990	j = surf_usm_v(l)%j(m)
6991	kw = surf_usm_v(l)%k(m)
6992
6993	IF ( l == 3 ) THEN ! westward facing
6994	iw = i
6995	jw = j
6996	ii = 6
6997	ij = 3
6998	ELSEIF ( l == 2 ) THEN
6999	iw = i-1
7000	jw = j
7001	ii = 6
7002	ij = 3
7003	ELSEIF ( l == 1 ) THEN
7004	iw = i
7005	jw = j
7006	ii = 12
7007	ij = 9
7008	ELSEIF ( l == 0 ) THEN
7009	iw = i
7010	jw = j-1
7011	ii = 12
7012	ij = 9
7013	ENDIF
7014
7015	IF ( iw < 0 .OR. jw < 0 ) THEN
7016	!-- wall on west or south border of the domain - assign default category
7017	IF ( kw <= roof_height_limit ) THEN
7018	surf_usm_v(l)%surface_types(m) = wall_category !< default category for wall surface in wall zone
7019	ELSE
7020	surf_usm_v(l)%surface_types(m) = roof_category !< default category for wall surface in roof zone
7021	END IF
7022	surf_usm_v(l)%albedo(:,m) = -1.0_wp
7023	surf_usm_v(l)%thickness_wall(m) = -1.0_wp
7024	ELSE IF ( kw <= usm_par(ii,jw,iw) ) THEN
7025	!-- pedestrian zone
7026	IF ( usm_par(ii+1,jw,iw) == 0 ) THEN
7027	surf_usm_v(l)%surface_types(m) = pedestrian_category !< default category for wall surface in pedestrian zone
7028	surf_usm_v(l)%albedo(:,m) = -1.0_wp
7029	surf_usm_v(l)%thickness_wall(m) = -1.0_wp
7030	surf_usm_v(l)%thickness_window(m) = -1.0_wp
7031	surf_usm_v(l)%thickness_green(m) = -1.0_wp
7032	surf_usm_v(l)%transmissivity(m) = -1.0_wp
7033	ELSE
7034	surf_usm_v(l)%surface_types(m) = usm_par(ii+1,jw,iw)
7035	surf_usm_v(l)%albedo(:,m) = usm_val(ij,jw,iw)
7036	surf_usm_v(l)%thickness_wall(m) = usm_val(ij+1,jw,iw)
7037	surf_usm_v(l)%thickness_window(m) = usm_val(ij+1,jw,iw)
7038	surf_usm_v(l)%thickness_green(m) = usm_val(ij+1,jw,iw)
7039	surf_usm_v(l)%transmissivity(m) = 0.0_wp
7040	ENDIF
7041	ELSE IF ( kw <= usm_par(ii+2,jw,iw) ) THEN
7042	!-- wall zone
7043	IF ( usm_par(ii+3,jw,iw) == 0 ) THEN
7044	surf_usm_v(l)%surface_types(m) = wall_category !< default category for wall surface
7045	surf_usm_v(l)%albedo(:,m) = -1.0_wp
7046	surf_usm_v(l)%thickness_wall(m) = -1.0_wp
7047	surf_usm_v(l)%thickness_window(m) = -1.0_wp
7048	surf_usm_v(l)%thickness_green(m) = -1.0_wp
7049	surf_usm_v(l)%transmissivity(m) = -1.0_wp
7050	ELSE
7051	surf_usm_v(l)%surface_types(m) = usm_par(ii+3,jw,iw)
7052	surf_usm_v(l)%albedo(:,m) = usm_val(ij+2,jw,iw)
7053	surf_usm_v(l)%thickness_wall(m) = usm_val(ij+3,jw,iw)
7054	surf_usm_v(l)%thickness_window(m) = usm_val(ij+3,jw,iw)
7055	surf_usm_v(l)%thickness_green(m) = usm_val(ij+3,jw,iw)
7056	surf_usm_v(l)%transmissivity(m) = 0.0_wp
7057	ENDIF
7058	ELSE IF ( kw <= usm_par(ii+4,jw,iw) ) THEN
7059	!-- roof zone
7060	IF ( usm_par(ii+5,jw,iw) == 0 ) THEN
7061	surf_usm_v(l)%surface_types(m) = roof_category !< default category for roof surface
7062	surf_usm_v(l)%albedo(:,m) = -1.0_wp
7063	surf_usm_v(l)%thickness_wall(m) = -1.0_wp
7064	surf_usm_v(l)%thickness_window(m) = -1.0_wp
7065	surf_usm_v(l)%thickness_green(m) = -1.0_wp
7066	surf_usm_v(l)%transmissivity(m) = -1.0_wp
7067	ELSE
7068	surf_usm_v(l)%surface_types(m) = usm_par(ii+5,jw,iw)
7069	surf_usm_v(l)%albedo(:,m) = usm_val(ij+4,jw,iw)
7070	surf_usm_v(l)%thickness_wall(m) = usm_val(ij+5,jw,iw)
7071	surf_usm_v(l)%thickness_window(m) = usm_val(ij+5,jw,iw)
7072	surf_usm_v(l)%thickness_green(m) = usm_val(ij+5,jw,iw)
7073	surf_usm_v(l)%transmissivity(m) = 0.0_wp
7074	ENDIF
7075	ELSE
7076	!
7077	!-- supply the default category
7078	IF ( kw <= roof_height_limit ) THEN
7079	surf_usm_v(l)%surface_types(m) = wall_category !< default category for wall surface in wall zone
7080	ELSE
7081	surf_usm_v(l)%surface_types(m) = roof_category !< default category for wall surface in roof zone
7082	END IF
7083	surf_usm_v(l)%albedo(:,m) = -1.0_wp
7084	surf_usm_v(l)%thickness_wall(m) = -1.0_wp
7085	ENDIF
7086	!
7087	!-- Find the type position
7088	it = surf_usm_v(l)%surface_types(m)
7089	ip = -99999
7090	DO k = 1, n_surface_types
7091	IF ( surface_type_codes(k) == it ) THEN
7092	ip = k
7093	EXIT
7094	ENDIF
7095	ENDDO
7096	IF ( ip == -99999 ) THEN
7097	!-- wall category not found
7098	WRITE (message_string, "(A,I7,A,3I5)") 'wall category ', it, &
7099	' not found for i,j,k=', iw,jw,kw
7100	WRITE(9,*) message_string
7101	ENDIF
7102	!
7103	!-- Albedo
7104	IF ( surf_usm_v(l)%albedo(ind_veg_wall,m) < 0.0_wp ) THEN
7105	surf_usm_v(l)%albedo(:,m) = surface_params(ialbedo,ip)
7106	ENDIF
7107	!-- Albedo type is 0 (custom), others are replaced later
7108	surf_usm_v(l)%albedo_type(:,m) = 0
7109	!-- Transmissivity of the windows
7110	IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp ) THEN
7111	surf_usm_v(l)%transmissivity(m) = 0.0_wp
7112	ENDIF
7113	!
7114	!-- emissivity of the wall
7115	surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
7116	!
7117	!-- heat conductivity lambda S between air and wall ( W m-2 K-1 )
7118	surf_usm_v(l)%lambda_surf(m) = surface_params(ilambdas,ip)
7119	surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
7120	surf_usm_v(l)%lambda_surf_green(m) = surface_params(ilambdas,ip)
7121	!
7122	!-- roughness length
7123	surf_usm_v(l)%z0(m) = surface_params(irough,ip)
7124	surf_usm_v(l)%z0h(m) = surface_params(iroughh,ip)
7125	surf_usm_v(l)%z0q(m) = surface_params(iroughh,ip)
7126	!
7127	!-- Surface skin layer heat capacity (J m-2 K-1 )
7128	surf_usm_v(l)%c_surface(m) = surface_params(icsurf,ip)
7129	surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
7130	surf_usm_v(l)%c_surface_green(m) = surface_params(icsurf,ip)
7131	!
7132	!-- wall material parameters:
7133	!-- thickness of the wall (m)
7134	!-- missing values are replaced by default value for category
7135	IF ( surf_usm_v(l)%thickness_wall(m) <= 0.001_wp ) THEN
7136	surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
7137	ENDIF
7138	IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp ) THEN
7139	surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
7140	ENDIF
7141	IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp ) THEN
7142	surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
7143	ENDIF
7144	!
7145	!-- volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
7146	surf_usm_v(l)%rho_c_wall(:,m) = surface_params(irhoC,ip)
7147	surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
7148	surf_usm_v(l)%rho_c_green(:,m) = surface_params(irhoC,ip)
7149	!
7150	!-- thermal conductivity lambda H of the wall (W m-1 K-1 )
7151	surf_usm_v(l)%lambda_h(:,m) = surface_params(ilambdah,ip)
7152	surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
7153	surf_usm_v(l)%lambda_h_green(:,m) = surface_params(ilambdah,ip)
7154
7155	ENDDO
7156	ENDDO
7157	!
7158	!-- Initialize wall layer thicknesses. Please note, this will be removed
7159	!-- after migration to Palm input data standard.
7160	DO k = nzb_wall, nzt_wall
7161	zwn(k) = zwn_default(k)
7162	zwn_green(k) = zwn_default_green(k)
7163	zwn_window(k) = zwn_default_window(k)
7164	ENDDO
7165	!
7166	!-- apply for all particular surface grids. First for horizontal surfaces
7167	DO m = 1, surf_usm_h%ns
7168	surf_usm_h%zw(:,m) = zwn(:) * surf_usm_h%thickness_wall(m)
7169	surf_usm_h%zw_green(:,m) = zwn_green(:) * surf_usm_h%thickness_green(m)
7170	surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
7171	ENDDO
7172	DO l = 0, 3
7173	DO m = 1, surf_usm_v(l)%ns
7174	surf_usm_v(l)%zw(:,m) = zwn(:) * surf_usm_v(l)%thickness_wall(m)
7175	surf_usm_v(l)%zw_green(:,m) = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
7176	surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
7177	ENDDO
7178	ENDDO
7179
7180	CALL location_message( ' types and parameters of urban surfaces read', .TRUE. )
7181
7182	END SUBROUTINE usm_read_urban_surface_types
7183
7184
7185	!------------------------------------------------------------------------------!
7186	! Description:
7187	! ------------
7188	!
7189	!> This function advances through the list of local surfaces to find given
7190	!> x, y, d, z coordinates
7191	!------------------------------------------------------------------------------!
7192	PURE FUNCTION advance_surface(isurfl_start, isurfl_stop, x, y, z, d) &
7193	result(isurfl)
7194
7195	INTEGER(iwp), INTENT(in) :: isurfl_start, isurfl_stop
7196	INTEGER(iwp), INTENT(in) :: x, y, z, d
7197	INTEGER(iwp) :: isx, isy, isz, isd
7198	INTEGER(iwp) :: isurfl
7199
7200	DO isurfl = isurfl_start, isurfl_stop
7201	isx = surfl(ix, isurfl)
7202	isy = surfl(iy, isurfl)
7203	isz = surfl(iz, isurfl)
7204	isd = surfl(id, isurfl)
7205	IF ( isx==x .and. isy==y .and. isz==z .and. isd==d ) RETURN
7206	ENDDO
7207
7208	!-- coordinate not found
7209	isurfl = -1
7210
7211	END FUNCTION
7212
7213
7214	!------------------------------------------------------------------------------!
7215	! Description:
7216	! ------------
7217	!
7218	!> This subroutine reads temperatures of respective material layers in walls,
7219	!> roofs and ground from input files. Data in the input file must be in
7220	!> standard order, i.e. horizontal surfaces first ordered by x, y and then
7221	!> vertical surfaces ordered by x, y, direction, z
7222	!------------------------------------------------------------------------------!
7223	SUBROUTINE usm_read_wall_temperature
7224
7225	INTEGER(iwp) :: i, j, k, d, ii, iline
7226	INTEGER(iwp) :: isurfl
7227	REAL(wp) :: rtsurf
7228	REAL(wp), DIMENSION(nzb_wall:nzt_wall+1) :: rtwall
7229
7230
7231
7232
7233	DO ii = 0, io_blocks-1
7234	IF ( ii == io_group ) THEN
7235
7236	!-- open wall temperature file
7237	OPEN( 152, file='WALL_TEMPERATURE'//coupling_char, action='read', &
7238	status='old', form='formatted', err=15 )
7239
7240	isurfl = 0
7241	iline = 1
7242	DO
7243	rtwall = -9999.0_wp !< for incomplete lines
7244	READ( 152, *, err=13, end=14 ) i, j, k, d, rtsurf, rtwall
7245
7246	IF ( nxl <= i .and. i <= nxr .and. &
7247	nys <= j .and. j <= nyn) THEN !< local processor
7248	!-- identify surface id
7249	isurfl = advance_surface(isurfl+1, nsurfl, i, j, k, d)
7250	IF ( isurfl == -1 ) THEN
7251	WRITE(message_string, '(a,4i5,a,i5,a)') 'Coordinates (xyzd) ', i, j, k, d, &
7252	' on line ', iline, &
7253	' in file WALL_TEMPERATURE are either not present or out of standard order of surfaces.'
7254	CALL message( 'usm_read_wall_temperature', 'PA0521', 1, 2, 0, 6, 0 )
7255	ENDIF
7256
7257	!-- assign temperatures
7258	IF ( d == 0 ) THEN
7259	t_surf_h(isurfl) = rtsurf
7260	t_wall_h(:,isurfl) = rtwall(:)
7261	ELSE
7262	t_surf_v(d-1)%t(isurfl) = rtsurf
7263	t_wall_v(d-1)%t(:,isurfl) = rtwall(:)
7264	ENDIF
7265	ENDIF
7266
7267	iline = iline + 1
7268	CYCLE
7269	13 WRITE(message_string, '(a,i5,a)') 'Error reading line ', iline, &
7270	' in file WALL_TEMPERATURE.'
7271	CALL message( 'usm_read_wall_temperature', 'PA0522', 1, 2, 0, 6, 0 )
7272	ENDDO
7273	14 CLOSE(152)
7274	CYCLE
7275	15 message_string = 'file WALL_TEMPERATURE'//TRIM(coupling_char)//' does not exist'
7276	CALL message( 'usm_read_wall_temperature', 'PA0523', 1, 2, 0, 6, 0 )
7277	ENDIF
7278	#if defined( __parallel )
7279	CALL MPI_BARRIER( comm2d, ierr )
7280	#endif
7281	ENDDO
7282
7283	CALL location_message( ' wall layer temperatures read', .TRUE. )
7284
7285	END SUBROUTINE usm_read_wall_temperature
7286
7287
7288
7289	!------------------------------------------------------------------------------!
7290	! Description:
7291	! ------------
7292	!> Solver for the energy balance at the ground/roof/wall surface.
7293	!> It follows basic ideas and structure of lsm_energy_balance
7294	!> with many simplifications and adjustments.
7295	!> TODO better description
7296	!------------------------------------------------------------------------------!
7297	SUBROUTINE usm_surface_energy_balance
7298
7299	IMPLICIT NONE
7300
7301	INTEGER(iwp) :: i, j, k, l, d, m !< running indices
7302
7303	REAL(wp) :: stend !< surface tendency
7304	REAL(wp) :: stend_window !< surface tendency
7305	REAL(wp) :: stend_green !< surface tendency
7306	REAL(wp) :: coef_1 !< first coeficient for prognostic equation
7307	REAL(wp) :: coef_window_1 !< first coeficient for prognostic window equation
7308	REAL(wp) :: coef_green_1 !< first coeficient for prognostic green wall equation
7309	REAL(wp) :: coef_2 !< second coeficient for prognostic equation
7310	REAL(wp) :: coef_window_2 !< second coeficient for prognostic window equation
7311	REAL(wp) :: coef_green_2 !< second coeficient for prognostic green wall equation
7312	REAL(wp) :: rho_cp !< rho_wall_surface * cp
7313	REAL(wp) :: f_shf !< factor for shf_eb
7314	REAL(wp) :: f_shf_window !< factor for shf_eb window
7315	REAL(wp) :: f_shf_green !< factor for shf_eb green wall
7316	REAL(wp) :: lambda_surface !< current value of lambda_surface (heat conductivity between air and wall)
7317	REAL(wp) :: lambda_surface_window !< current value of lambda_surface (heat conductivity between air and window)
7318	REAL(wp) :: lambda_surface_green !< current value of lambda_surface (heat conductivity between air and greeb wall)
7319	REAL(wp), DIMENSION(nzb:nzt) :: exn !< value of the Exner function in layers
7320
7321	REAL(wp) :: dtime !< simulated time of day (in UTC)
7322	INTEGER(iwp) :: dhour !< simulated hour of day (in UTC)
7323	REAL(wp) :: acoef !< actual coefficient of diurnal profile of anthropogenic heat
7324
7325
7326	#if ! defined( __nopointer )
7327	exn(nzb:nzt) = (hyp(nzb:nzt) / 100000.0_wp )**0.286_wp !< Exner function
7328	#endif
7329	!
7330	!-- First, treat horizontal surface elements
7331	DO m = 1, surf_usm_h%ns
7332	!
7333	!-- Get indices of respective grid point
7334	i = surf_usm_h%i(m)
7335	j = surf_usm_h%j(m)
7336	k = surf_usm_h%k(m)
7337	!
7338	!-- TODO - how to calculate lambda_surface for horizontal surfaces
7339	!-- (lambda_surface is set according to stratification in land surface model)
7340	!-- MS: ???
7341	IF ( surf_usm_h%ol(m) >= 0.0_wp ) THEN
7342	lambda_surface = surf_usm_h%lambda_surf(m)
7343	lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7344	lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7345	ELSE
7346	lambda_surface = surf_usm_h%lambda_surf(m)
7347	lambda_surface_window = surf_usm_h%lambda_surf_window(m)
7348	lambda_surface_green = surf_usm_h%lambda_surf_green(m)
7349	ENDIF
7350	#if ! defined( __nopointer )
7351	!
7352	!-- calculate rho * cp coefficient at surface layer
7353	rho_cp = cp * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exn(k) )
7354	#endif
7355	!
7356	!-- Calculate aerodyamic resistance.
7357	!-- Calculation for horizontal surfaces follows LSM formulation
7358	!-- pt, us, ts are not available for the prognostic time step,
7359	!-- data from the last time step is used here.
7360
7361	!-- Workaround: use single r_a as stability is only treated for the
7362	!-- average temperature
7363	surf_usm_h%r_a(m) = ( surf_usm_h%pt1(m) - surf_usm_h%pt_surface(m) ) /&
7364	( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7365	surf_usm_h%r_a_window(m) = surf_usm_h%r_a(m)
7366	surf_usm_h%r_a_green(m) = surf_usm_h%r_a(m)
7367
7368	! r_a = ( surf_usm_h%pt1(m) - t_surf_h(m) / exn(k) ) / &
7369	! ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7370	! r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exn(k) ) / &
7371	! ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7372	! r_a_green = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exn(k) ) / &
7373	! ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
7374
7375	!-- make sure that the resistance does not drop to zero
7376	IF ( surf_usm_h%r_a(m) < 1.0_wp ) &
7377	surf_usm_h%r_a(m) = 1.0_wp
7378	IF ( surf_usm_h%r_a_green(m) < 1.0_wp ) &
7379	surf_usm_h%r_a_green(m) = 1.0_wp
7380	IF ( surf_usm_h%r_a_window(m) < 1.0_wp ) &
7381	surf_usm_h%r_a_window(m) = 1.0_wp
7382
7383	!-- factor for shf_eb
7384	f_shf = rho_cp / surf_usm_h%r_a(m)
7385	f_shf_window = rho_cp / surf_usm_h%r_a_window(m)
7386	f_shf_green = rho_cp / surf_usm_h%r_a_green(m)
7387
7388	!-- add LW up so that it can be removed in prognostic equation
7389	surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m) - &
7390	surf_usm_h%rad_sw_out(m) + &
7391	surf_usm_h%rad_lw_in(m) - &
7392	surf_usm_h%rad_lw_out(m)
7393
7394	!-- numerator of the prognostic equation
7395	!-- Todo: Adjust to tile approach. So far, emissivity for wall (element 0)
7396	!-- is used
7397	coef_1 = surf_usm_h%rad_net_l(m) + &
7398	( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_veg_wall,m) * &
7399	sigma_sb * t_surf_h(m) ** 4 + &
7400	f_shf * surf_usm_h%pt1(m) + &
7401	lambda_surface * t_wall_h(nzb_wall,m)
7402	coef_window_1 = surf_usm_h%rad_net_l(m) + &
7403	( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_wat_win,m) &
7404	* sigma_sb * t_surf_window_h(m) ** 4 + &
7405	f_shf_window * surf_usm_h%pt1(m) + &
7406	lambda_surface_window * t_window_h(nzb_wall,m)
7407	coef_green_1 = surf_usm_h%rad_net_l(m) + &
7408	( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(ind_pav_green,m) *&
7409	sigma_sb * t_surf_green_h(m) ** 4 + &
7410	f_shf_green * surf_usm_h%pt1(m) + &
7411	lambda_surface_green * t_wall_h(nzb_wall,m)
7412
7413	!-- denominator of the prognostic equation
7414	coef_2 = 4.0_wp * surf_usm_h%emissivity(ind_veg_wall,m) * &
7415	sigma_sb * t_surf_h(m) ** 3 &
7416	+ lambda_surface + f_shf / exn(k)
7417	coef_window_2 = 4.0_wp * surf_usm_h%emissivity(ind_wat_win,m) * &
7418	sigma_sb * t_surf_window_h(m) ** 3 &
7419	+ lambda_surface_window + f_shf_window / exn(k)
7420	coef_green_2 = 4.0_wp * surf_usm_h%emissivity(ind_pav_green,m) * &
7421	sigma_sb * t_surf_green_h(m) ** 3 &
7422	+ lambda_surface_green + f_shf_green / exn(k)
7423
7424	!-- implicit solution when the surface layer has no heat capacity,
7425	!-- otherwise use RK3 scheme.
7426	t_surf_h_p(m) = ( coef_1 * dt_3d * tsc(2) + &
7427	surf_usm_h%c_surface(m) * t_surf_h(m) ) / &
7428	( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) )
7429	t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) + &
7430	surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) / &
7431	( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
7432	t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) + &
7433	surf_usm_h%c_surface_green(m) * t_surf_green_h(m) ) / &
7434	( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
7435
7436	!-- add RK3 term
7437	t_surf_h_p(m) = t_surf_h_p(m) + dt_3d * tsc(3) * &
7438	surf_usm_h%tt_surface_m(m)
7439	t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) * &
7440	surf_usm_h%tt_surface_window_m(m)
7441	t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) * &
7442	surf_usm_h%tt_surface_green_m(m)
7443	!
7444	!-- Store surface temperature on pt_surface. Further, in case humidity is used
7445	!-- store also vpt_surface, which is, due to the lack of moisture on roofs simply
7446	!-- assumed to be the surface temperature.
7447	surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(ind_veg_wall,m) * t_surf_h_p(m) &
7448	+ surf_usm_h%frac(ind_wat_win,m) * t_surf_window_h_p(m) &
7449	+ surf_usm_h%frac(ind_pav_green,m) * t_surf_green_h_p(m) ) &
7450	/ exn(k)
7451
7452	IF ( humidity ) surf_usm_h%vpt_surface(m) = &
7453	surf_usm_h%pt_surface(m)
7454
7455	!-- calculate true tendency
7456	stend = ( t_surf_h_p(m) - t_surf_h(m) - dt_3d * tsc(3) * &
7457	surf_usm_h%tt_surface_m(m)) / ( dt_3d * tsc(2) )
7458	stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) * &
7459	surf_usm_h%tt_surface_window_m(m)) / ( dt_3d * tsc(2) )
7460	stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) * &
7461	surf_usm_h%tt_surface_green_m(m)) / ( dt_3d * tsc(2) )
7462
7463	!-- calculate t_surf tendencies for the next Runge-Kutta step
7464	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7465	IF ( intermediate_timestep_count == 1 ) THEN
7466	surf_usm_h%tt_surface_m(m) = stend
7467	surf_usm_h%tt_surface_window_m(m) = stend_window
7468	surf_usm_h%tt_surface_green_m(m) = stend_green
7469	ELSEIF ( intermediate_timestep_count < &
7470	intermediate_timestep_count_max ) THEN
7471	surf_usm_h%tt_surface_m(m) = -9.5625_wp * stend + &
7472	5.3125_wp * surf_usm_h%tt_surface_m(m)
7473	surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window + &
7474	5.3125_wp * surf_usm_h%tt_surface_window_m(m)
7475	surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green + &
7476	5.3125_wp * surf_usm_h%tt_surface_green_m(m)
7477	ENDIF
7478	ENDIF
7479
7480	!-- in case of fast changes in the skin temperature, it is required to
7481	!-- update the radiative fluxes in order to keep the solution stable
7482	IF ( ( ABS( t_surf_h_p(m) - t_surf_h(m) ) > 1.0_wp ) .OR. &
7483	( ABS( t_surf_green_h_p(m) - t_surf_green_h(m) ) > 1.0_wp ) .OR. &
7484	( ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) ) THEN
7485	force_radiation_call_l = .TRUE.
7486	ENDIF
7487	!
7488	!-- calculate fluxes
7489	!-- rad_net_l is never used!
7490	surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) + &
7491	surf_usm_h%frac(ind_veg_wall,m) * &
7492	sigma_sb * surf_usm_h%emissivity(ind_veg_wall,m) * &
7493	( t_surf_h_p(m)4 - t_surf_h(m)4 ) &
7494	+ surf_usm_h%frac(ind_wat_win,m) * &
7495	sigma_sb * surf_usm_h%emissivity(ind_wat_win,m) * &
7496	( t_surf_window_h_p(m)4 - t_surf_window_h(m)4 ) &
7497	+ surf_usm_h%frac(ind_pav_green,m) * &
7498	sigma_sb * surf_usm_h%emissivity(ind_pav_green,m) * &
7499	( t_surf_green_h_p(m)4 - t_surf_green_h(m)4 )
7500
7501	surf_usm_h%wghf_eb(m) = lambda_surface * &
7502	( t_surf_h_p(m) - t_wall_h(nzb_wall,m) )
7503	surf_usm_h%wghf_eb_green(m) = lambda_surface_green * &
7504	( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
7505	surf_usm_h%wghf_eb_window(m) = lambda_surface_window * &
7506	( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
7507
7508	!
7509	!-- ground/wall/roof surface heat flux
7510	surf_usm_h%wshf_eb(m) = - f_shf * ( surf_usm_h%pt1(m) - t_surf_h_p(m) / exn(k) ) * &
7511	surf_usm_h%frac(ind_veg_wall,m) &
7512	- f_shf_window * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exn(k) ) * &
7513	surf_usm_h%frac(ind_wat_win,m) &
7514	- f_shf_green * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exn(k) ) * &
7515	surf_usm_h%frac(ind_pav_green,m)
7516	!
7517	!-- store kinematic surface heat fluxes for utilization in other processes
7518	!-- diffusion_s, surface_layer_fluxes,...
7519	surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / cp
7520
7521	ENDDO
7522	!
7523	!-- Now, treat vertical surface elements
7524	DO l = 0, 3
7525	DO m = 1, surf_usm_v(l)%ns
7526	!
7527	!-- Get indices of respective grid point
7528	i = surf_usm_v(l)%i(m)
7529	j = surf_usm_v(l)%j(m)
7530	k = surf_usm_v(l)%k(m)
7531
7532	!
7533	!-- TODO - how to calculate lambda_surface for horizontal (??? do you mean verical ???) surfaces
7534	!-- (lambda_surface is set according to stratification in land surface model).
7535	!-- Please note, for vertical surfaces no ol is defined, since
7536	!-- stratification is not considered in this case.
7537	lambda_surface = surf_usm_v(l)%lambda_surf(m)
7538	lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
7539	lambda_surface_green = surf_usm_v(l)%lambda_surf_green(m)
7540
7541	#if ! defined( __nopointer )
7542	!
7543	!-- calculate rho * cp coefficient at surface layer
7544	rho_cp = cp * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exn(k) )
7545	#endif
7546
7547	!-- Calculation of r_a for vertical surfaces
7548	!--
7549	!-- heat transfer coefficient for forced convection along vertical walls
7550	!-- follows formulation in TUF3d model (Krayenhoff & Voogt, 2006)
7551	!--
7552	!-- H = httc (Tsfc - Tair)
7553	!-- httc = rw * (11.8 + 4.2 * Ueff) - 4.0
7554	!--
7555	!-- rw: wall patch roughness relative to 1.0 for concrete
7556	!-- Ueff: effective wind speed
7557	!-- - 4.0 is a reduction of Rowley et al (1930) formulation based on
7558	!-- Cole and Sturrock (1977)
7559	!--
7560	!-- Ucan: Canyon wind speed
7561	!-- wstar: convective velocity
7562	!-- Qs: surface heat flux
7563	!-- zH: height of the convective layer
7564	!-- wstar = (g/TcanQszH)**(1./3.)
7565
7566	!-- Effective velocity components must always
7567	!-- be defined at scalar grid point. The wall normal component is
7568	!-- obtained by simple linear interpolation. ( An alternative would
7569	!-- be an logarithmic interpolation. )
7570	!-- A roughness lenght of 0.001 is assumed for concrete (the inverse,
7571	!-- 1000 is used in the nominator for scaling)
7572	surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) * 1000.0_wp &
7573	* ( 11.8_wp + 4.2_wp * &
7574	SQRT( MAX( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 + &
7575	( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 + &
7576	( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2, &
7577	0.01_wp ) ) &
7578	) - 4.0_wp )
7579	!
7580	!-- Limit aerodynamic resistance
7581	IF ( surf_usm_v(l)%r_a(m) < 1.0_wp ) &
7582	surf_usm_v(l)%r_a(m) = 1.0_wp
7583
7584	f_shf = rho_cp / surf_usm_v(l)%r_a(m)
7585	f_shf_window = rho_cp / surf_usm_v(l)%r_a(m)
7586	f_shf_green = rho_cp / surf_usm_v(l)%r_a(m)
7587
7588
7589
7590	!-- add LW up so that it can be removed in prognostic equation
7591	surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m) - &
7592	surf_usm_v(l)%rad_sw_out(m) + &
7593	surf_usm_v(l)%rad_lw_in(m) - &
7594	surf_usm_v(l)%rad_lw_out(m)
7595
7596	!-- numerator of the prognostic equation
7597	coef_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout included in calculation of radnet_l
7598	( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_veg_wall,m) * &
7599	sigma_sb * t_surf_v(l)%t(m) ** 4 + &
7600	f_shf * surf_usm_v(l)%pt1(m) + &
7601	lambda_surface * t_wall_v(l)%t(nzb_wall,m)
7602	coef_window_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout included in calculation of radnet_l
7603	( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_wat_win,m) * &
7604	sigma_sb * t_surf_window_v(l)%t(m) ** 4 + &
7605	f_shf * surf_usm_v(l)%pt1(m) + &
7606	lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
7607
7608	coef_green_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout included in calculation of radnet_l
7609	( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(ind_pav_green,m) *&
7610	sigma_sb * t_surf_green_v(l)%t(m) ** 4 + &
7611	f_shf * surf_usm_v(l)%pt1(m) + &
7612	lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
7613
7614	!-- denominator of the prognostic equation
7615	coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_veg_wall,m) * &
7616	sigma_sb * t_surf_v(l)%t(m) ** 3 &
7617	+ lambda_surface + f_shf / exn(k)
7618	coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_wat_win,m) *&
7619	sigma_sb * t_surf_window_v(l)%t(m) ** 3 &
7620	+ lambda_surface_window + f_shf / exn(k)
7621	coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(ind_pav_green,m) *&
7622	sigma_sb * t_surf_green_v(l)%t(m) ** 3 &
7623	+ lambda_surface_green + f_shf / exn(k)
7624
7625	!-- implicit solution when the surface layer has no heat capacity,
7626	!-- otherwise use RK3 scheme.
7627	t_surf_v_p(l)%t(m) = ( coef_1 * dt_3d * tsc(2) + &
7628	surf_usm_v(l)%c_surface(m) * t_surf_v(l)%t(m) ) / &
7629	( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) )
7630	t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) + &
7631	surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / &
7632	( surf_usm_v(l)%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
7633
7634	t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) + &
7635	surf_usm_v(l)%c_surface_green(m) * t_surf_green_v(l)%t(m) ) / &
7636	( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
7637
7638
7639
7640	!-- add RK3 term
7641	t_surf_v_p(l)%t(m) = t_surf_v_p(l)%t(m) + dt_3d * tsc(3) * &
7642	surf_usm_v(l)%tt_surface_m(m)
7643	t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) * &
7644	surf_usm_v(l)%tt_surface_window_m(m)
7645	t_surf_green_v_p(l)%t(m) = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) * &
7646	surf_usm_v(l)%tt_surface_green_m(m)
7647	!
7648	!-- Store surface temperature. Further, in case humidity is used
7649	!-- store also vpt_surface, which is, due to the lack of moisture on roofs simply
7650	!-- assumed to be the surface temperature.
7651	surf_usm_v(l)%pt_surface(m) = ( surf_usm_v(l)%frac(ind_veg_wall,m) * t_surf_v_p(l)%t(m) &
7652	+ surf_usm_v(l)%frac(ind_wat_win,m) * t_surf_window_v_p(l)%t(m) &
7653	+ surf_usm_v(l)%frac(ind_pav_green,m) * t_surf_green_v_p(l)%t(m) ) &
7654	/ exn(k)
7655
7656	IF ( humidity ) surf_usm_v(l)%vpt_surface(m) = &
7657	surf_usm_v(l)%pt_surface(m)
7658
7659	!-- calculate true tendency
7660	stend = ( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) - dt_3d * tsc(3) *&
7661	surf_usm_v(l)%tt_surface_m(m) ) / ( dt_3d * tsc(2) )
7662	stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) *&
7663	surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d * tsc(2) )
7664	stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *&
7665	surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d * tsc(2) )
7666
7667	!-- calculate t_surf tendencies for the next Runge-Kutta step
7668	IF ( timestep_scheme(1:5) == 'runge' ) THEN
7669	IF ( intermediate_timestep_count == 1 ) THEN
7670	surf_usm_v(l)%tt_surface_m(m) = stend
7671	surf_usm_v(l)%tt_surface_window_m(m) = stend_window
7672	surf_usm_v(l)%tt_surface_green_m(m) = stend_green
7673	ELSEIF ( intermediate_timestep_count < &
7674	intermediate_timestep_count_max ) THEN
7675	surf_usm_v(l)%tt_surface_m(m) = -9.5625_wp * stend + &
7676	5.3125_wp * surf_usm_v(l)%tt_surface_m(m)
7677	surf_usm_v(l)%tt_surface_green_m(m) = -9.5625_wp * stend_green + &
7678	5.3125_wp * surf_usm_v(l)%tt_surface_green_m(m)
7679	surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window + &
7680	5.3125_wp * surf_usm_v(l)%tt_surface_window_m(m)
7681	ENDIF
7682	ENDIF
7683
7684	!-- in case of fast changes in the skin temperature, it is required to
7685	!-- update the radiative fluxes in order to keep the solution stable
7686
7687	IF ( ( ABS( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) ) > 1.0_wp ) .OR. &
7688	( ABS( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) ) > 1.0_wp ) .OR. &
7689	( ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) ) THEN
7690	force_radiation_call_l = .TRUE.
7691	ENDIF
7692
7693	!-- calculate fluxes
7694	!-- prognostic rad_net_l is used just for output!
7695	surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(ind_veg_wall,m) * &
7696	( surf_usm_v(l)%rad_net_l(m) + &
7697	3.0_wp * sigma_sb * &
7698	t_surf_v(l)%t(m)*4 - 4.0_wp sigma_sb * &
7699	t_surf_v(l)%t(m)*3 t_surf_v_p(l)%t(m) ) &
7700	+ surf_usm_v(l)%frac(ind_wat_win,m) * &
7701	( surf_usm_v(l)%rad_net_l(m) + &
7702	3.0_wp * sigma_sb * &
7703	t_surf_window_v(l)%t(m)*4 - 4.0_wp sigma_sb * &
7704	t_surf_window_v(l)%t(m)*3 t_surf_window_v_p(l)%t(m) ) &
7705	+ surf_usm_v(l)%frac(ind_pav_green,m) * &
7706	( surf_usm_v(l)%rad_net_l(m) + &
7707	3.0_wp * sigma_sb * &
7708	t_surf_green_v(l)%t(m)*4 - 4.0_wp sigma_sb * &
7709	t_surf_green_v(l)%t(m)*3 t_surf_green_v_p(l)%t(m) )
7710
7711	surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window * &
7712	( t_surf_window_v_p(l)%t(m) - t_window_v(l)%t(nzb_wall,m) )
7713	surf_usm_v(l)%wghf_eb(m) = lambda_surface * &
7714	( t_surf_v_p(l)%t(m) - t_wall_v(l)%t(nzb_wall,m) )
7715	surf_usm_v(l)%wghf_eb_green(m) = lambda_surface_green * &
7716	( t_surf_green_v_p(l)%t(m) - t_green_v(l)%t(nzb_wall,m) )
7717
7718	!-- ground/wall/roof surface heat flux
7719	surf_usm_v(l)%wshf_eb(m) = &
7720	- f_shf * ( surf_usm_v(l)%pt1(m) - &
7721	t_surf_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(ind_veg_wall,m) &
7722	- f_shf_window * ( surf_usm_v(l)%pt1(m) - &
7723	t_surf_window_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(ind_wat_win,m)&
7724	- f_shf_green * ( surf_usm_v(l)%pt1(m) - &
7725	t_surf_green_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(ind_pav_green,m)
7726
7727	!
7728	!-- store kinematic surface heat fluxes for utilization in other processes
7729	!-- diffusion_s, surface_layer_fluxes,...
7730	surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / cp
7731
7732	ENDDO
7733
7734	ENDDO
7735	!
7736	!-- Add-up anthropogenic heat, for now only at upward-facing surfaces
7737	IF ( usm_anthropogenic_heat .AND. &
7738	intermediate_timestep_count == intermediate_timestep_count_max ) THEN
7739	!-- application of the additional anthropogenic heat sources
7740	!-- we considere the traffic for now so all heat is absorbed
7741	!-- to the first layer, generalization would be worth.
7742
7743	!-- calculation of actual profile coefficient
7744	!-- ??? check time_since_reference_point ???
7745	dtime = mod(simulated_time + time_utc_init, 24.0_wp*3600.0_wp)
7746	dhour = INT(dtime/3600.0_wp)
7747	DO m = 1, naheatlayers
7748	!-- Get indices of respective grid point
7749	i = surf_usm_h%i(m)
7750	j = surf_usm_h%j(m)
7751	k = surf_usm_h%k(m)
7752	IF ( k > get_topography_top_index_ji( j, i, 's' ) .AND. &
7753	k <= naheatlayers ) THEN
7754	!-- increase of pt in box i,j,k in time dt_3d
7755	!-- given to anthropogenic heat aheatacoef (Wm-2)
7756	!-- linear interpolation of coeficient
7757	acoef = (REAL(dhour+1,wp)-dtime/3600.0_wp)*aheatprof(k,dhour) + &
7758	(dtime/3600.0_wp-REAL(dhour,wp))*aheatprof(k,dhour+1)
7759	IF ( aheat(k,j,i) > 0.0_wp ) THEN
7760	pt(k,j,i) = pt(k,j,i) + aheat(k,j,i)acoefdt_3d/(exn(k)rho_cpdzu(k))
7761	ENDIF
7762	ENDIF
7763	ENDDO
7764
7765	ENDIF
7766
7767	!-- pt and shf are defined on nxlg:nxrg,nysg:nyng
7768	!-- get the borders from neighbours
7769	#if ! defined( __nopointer )
7770	CALL exchange_horiz( pt, nbgp )
7771	#endif
7772
7773	!-- calculation of force_radiation_call:
7774	!-- Make logical OR for all processes.
7775	!-- Force radiation call if at least one processor forces it.
7776	IF ( intermediate_timestep_count == intermediate_timestep_count_max-1 )&
7777	THEN
7778	#if defined( __parallel )
7779	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
7780	CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call, &
7781	1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
7782	#else
7783	force_radiation_call = force_radiation_call_l
7784	#endif
7785	force_radiation_call_l = .FALSE.
7786	ENDIF
7787
7788	END SUBROUTINE usm_surface_energy_balance
7789
7790
7791	!------------------------------------------------------------------------------!
7792	! Description:
7793	! ------------
7794	!> Swapping of timelevels for t_surf and t_wall
7795	!> called out from subroutine swap_timelevel
7796	!------------------------------------------------------------------------------!
7797	SUBROUTINE usm_swap_timelevel ( mod_count )
7798
7799	IMPLICIT NONE
7800
7801	INTEGER(iwp), INTENT(IN) :: mod_count
7802	INTEGER(iwp) :: i
7803
7804	#if defined( __nopointer )
7805	t_surf_h = t_surf_h_p
7806	t_wall_h = t_wall_h_p
7807	t_surf_v = t_surf_v_p
7808	t_wall_v = t_wall_v_p
7809	t_surf_window_h = t_surf_window_h_p
7810	t_window_h = t_window_h_p
7811	t_surf_window_v = t_surf_window_v_p
7812	t_window_v = t_window_v_p
7813	t_surf_green_h = t_surf_green_h_p
7814	t_surf_green_v = t_surf_green_v_p
7815	t_green_h = t_green_h_p
7816	t_green_v = t_green_v_p
7817	#else
7818	SELECT CASE ( mod_count )
7819	CASE ( 0 )
7820	!
7821	!-- Horizontal surfaces
7822	t_surf_h => t_surf_h_1; t_surf_h_p => t_surf_h_2
7823	t_wall_h => t_wall_h_1; t_wall_h_p => t_wall_h_2
7824	t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2
7825	t_window_h => t_window_h_1; t_window_h_p => t_window_h_2
7826	t_surf_green_h => t_surf_green_h_1; t_surf_green_h_p => t_surf_green_h_2
7827	t_green_h => t_green_h_1; t_green_h_p => t_green_h_2
7828	!
7829	!-- Vertical surfaces
7830	t_surf_v => t_surf_v_1; t_surf_v_p => t_surf_v_2
7831	t_wall_v => t_wall_v_1; t_wall_v_p => t_wall_v_2
7832	t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
7833	t_window_v => t_window_v_1; t_window_v_p => t_window_v_2
7834	t_surf_green_v => t_surf_green_v_1; t_surf_green_v_p => t_surf_green_v_2
7835	t_green_v => t_green_v_1; t_green_v_p => t_green_v_2
7836	CASE ( 1 )
7837	!
7838	!-- Horizontal surfaces
7839	t_surf_h => t_surf_h_2; t_surf_h_p => t_surf_h_1
7840	t_wall_h => t_wall_h_2; t_wall_h_p => t_wall_h_1
7841	t_surf_window_h => t_surf_window_h_2; t_surf_window_h_p => t_surf_window_h_1
7842	t_window_h => t_window_h_2; t_window_h_p => t_window_h_1
7843	t_surf_green_h => t_surf_green_h_2; t_surf_green_h_p => t_surf_green_h_1
7844	t_green_h => t_green_h_2; t_green_h_p => t_green_h_1
7845	!
7846	!-- Vertical surfaces
7847	t_surf_v => t_surf_v_2; t_surf_v_p => t_surf_v_1
7848	t_wall_v => t_wall_v_2; t_wall_v_p => t_wall_v_1
7849	t_surf_window_v => t_surf_window_v_2; t_surf_window_v_p => t_surf_window_v_1
7850	t_window_v => t_window_v_2; t_window_v_p => t_window_v_1
7851	t_surf_green_v => t_surf_green_v_2; t_surf_green_v_p => t_surf_green_v_1
7852	t_green_v => t_green_v_2; t_green_v_p => t_green_v_1
7853	END SELECT
7854	#endif
7855
7856	END SUBROUTINE usm_swap_timelevel
7857
7858	!------------------------------------------------------------------------------!
7859	! Description:
7860	! ------------
7861	!> Subroutine writes t_surf and t_wall data into restart files
7862	!------------------------------------------------------------------------------!
7863	SUBROUTINE usm_wrd_local
7864
7865
7866	IMPLICIT NONE
7867
7868	CHARACTER(LEN=1) :: dum !< dummy string to create output-variable name
7869	INTEGER(iwp) :: l !< index surface type orientation
7870
7871	CALL wrd_write_string( 'ns_h_on_file_usm' )
7872	WRITE ( 14 ) surf_usm_h%ns
7873
7874	CALL wrd_write_string( 'ns_v_on_file_usm' )
7875	WRITE ( 14 ) surf_usm_v(0:3)%ns
7876
7877	CALL wrd_write_string( 'usm_start_index_h' )
7878	WRITE ( 14 ) surf_usm_h%start_index
7879
7880	CALL wrd_write_string( 'usm_end_index_h' )
7881	WRITE ( 14 ) surf_usm_h%end_index
7882
7883	CALL wrd_write_string( 't_surf_h' )
7884	WRITE ( 14 ) t_surf_h
7885
7886	CALL wrd_write_string( 't_surf_window_h' )
7887	WRITE ( 14 ) t_surf_window_h
7888
7889	CALL wrd_write_string( 't_surf_green_h' )
7890	WRITE ( 14 ) t_surf_green_h
7891
7892	DO l = 0, 3
7893
7894	CALL wrd_write_string( 'usm_start_index_v' )
7895	WRITE ( 14 ) surf_usm_v(l)%start_index
7896
7897	CALL wrd_write_string( 'usm_end_index_v' )
7898	WRITE ( 14 ) surf_usm_v(l)%end_index
7899
7900	WRITE( dum, '(I1)') l
7901
7902	CALL wrd_write_string( 't_surf_v(' // dum // ')' )
7903	WRITE ( 14 ) t_surf_v(l)%t
7904
7905	CALL wrd_write_string( 't_surf_window_v(' // dum // ')' )
7906	WRITE ( 14 ) t_surf_window_v(l)%t
7907
7908	CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
7909	WRITE ( 14 ) t_surf_green_v(l)%t
7910
7911	ENDDO
7912
7913	CALL wrd_write_string( 'usm_start_index_h' )
7914	WRITE ( 14 ) surf_usm_h%start_index
7915
7916	CALL wrd_write_string( 'usm_end_index_h' )
7917	WRITE ( 14 ) surf_usm_h%end_index
7918
7919	CALL wrd_write_string( 't_wall_h' )
7920	WRITE ( 14 ) t_wall_h
7921
7922	CALL wrd_write_string( 't_window_h' )
7923	WRITE ( 14 ) t_window_h
7924
7925	CALL wrd_write_string( 't_green_h' )
7926	WRITE ( 14 ) t_green_h
7927
7928	DO l = 0, 3
7929
7930	CALL wrd_write_string( 'usm_start_index_v' )
7931	WRITE ( 14 ) surf_usm_v(l)%start_index
7932
7933	CALL wrd_write_string( 'usm_end_index_v' )
7934	WRITE ( 14 ) surf_usm_v(l)%end_index
7935
7936	WRITE( dum, '(I1)') l
7937
7938	CALL wrd_write_string( 't_wall_v(' // dum // ')' )
7939	WRITE ( 14 ) t_wall_v(l)%t
7940
7941	CALL wrd_write_string( 't_window_v(' // dum // ')' )
7942	WRITE ( 14 ) t_window_v(l)%t
7943
7944	CALL wrd_write_string( 't_green_v(' // dum // ')' )
7945	WRITE ( 14 ) t_green_v(l)%t
7946
7947	ENDDO
7948
7949
7950	END SUBROUTINE usm_wrd_local
7951
7952	!
7953	!-- Integrated stability function for heat and moisture
7954	FUNCTION psi_h( zeta )
7955
7956	USE kinds
7957
7958	IMPLICIT NONE
7959
7960	REAL(wp) :: psi_h !< Integrated similarity function result
7961	REAL(wp) :: zeta !< Stability parameter z/L
7962	REAL(wp) :: x !< dummy variable
7963
7964	REAL(wp), PARAMETER :: a = 1.0_wp !< constant
7965	REAL(wp), PARAMETER :: b = 0.66666666666_wp !< constant
7966	REAL(wp), PARAMETER :: c = 5.0_wp !< constant
7967	REAL(wp), PARAMETER :: d = 0.35_wp !< constant
7968	REAL(wp), PARAMETER :: c_d_d = c / d !< constant
7969	REAL(wp), PARAMETER :: bc_d_d = b * c / d !< constant
7970
7971
7972	IF ( zeta < 0.0_wp ) THEN
7973	x = SQRT( 1.0_wp - 16.0_wp * zeta )
7974	psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp )
7975	ELSE
7976	psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - (1.0_wp &
7977	+ 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d &
7978	+ 1.0_wp
7979	!
7980	!-- Old version for stable conditions (only valid for z/L < 0.5)
7981	!-- psi_h = - 5.0_wp * zeta
7982	ENDIF
7983
7984	END FUNCTION psi_h
7985
7986	END MODULE urban_surface_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |