Home

Context Navigation

source: palm/trunk/SOURCE/land_surface_model_mod.f90 @ 4312

Last change on this file since 4312 was 4312, checked in by suehring, 5 years ago
Checks and initialization for relative surface fractions revised
Property svn:keywords set to `Id`
File size: 351.5 KB

Line
1	!> @file land_surface_model_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 1997-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	! Initialization of relative surface fractions revised
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: land_surface_model_mod.f90 4312 2019-11-27 14:06:25Z suehring $
27	! Bugfix: partitioning of LE from liquid water reservoir fixed. Bare soils are
28	! now allowed to store liquid water at the surface.
29	!
30	! 4261 2019-10-09 17:58:00Z scharf
31	! bugfix for rev. 4258: deallocate temporary arrays
32	!
33	! 4258 2019-10-07 13:29:08Z suehring
34	! - Revise limitation for soil moisture in case it exceeds its saturation
35	! value (J. Resler)
36	! - Revise initialization of soil moisture and temperature in a nested run in
37	! case dynamic input information is available. This case, the soil within
38	! the child domains can be initialized separately. (J. Resler, M. Suehring)
39	! - As part of this revision, migrate the netcdf input of soil temperature /
40	! moisture to this module, as well as the routine to inter/extrapolate soil
41	! profiles between different grids.
42	!
43	! 4251 2019-10-02 12:07:38Z maronga
44	! Bugfix: albedo_types for vegetation_type look-up table corrected.
45	!
46	! 4201 2019-08-29 15:47:27Z suehring
47	! - Limit soil moisture to its saturation moisture and give a respective
48	! warning rather than an error.
49	! - Perform checks for soil temperature only when there is no dynamic input
50	! file for the parent or possible child domains.
51	!
52	! 4194 2019-08-28 08:09:44Z suehring
53	! Apply more strict limitation of z0 over water surfaces in case it exceeds the
54	! surface-layer height, in order to avoid instabilities.
55	!
56	! 4188 2019-08-26 14:15:47Z suehring
57	! Minor adjustment in error numbers, typos corrected
58	!
59	! 4187 2019-08-26 12:43:15Z suehring
60	! Adjust message call in case of local checks
61	!
62	! 4182 2019-08-22 15:20:23Z scharf
63	! Corrected "Former revisions" section
64	!
65	! 4118 2019-07-25 16:11:45Z suehring
66	! Initialization of soil temperature and moisture via dynamic input file only
67	! for vegetation and pavement surfaces.
68	!
69	! 4110 2019-07-22 17:05:21Z suehring
70	! Relax checks for non-consistent initialization in case static or dynamic
71	! input is provided. For example, soil_temperature or deep_soil_temperature
72	! is not mandatory any more if dynamic input is available. Also, improper
73	! settings of x_type in namelist are only checked if no static file is
74	! available.
75	!
76	! 4109 2019-07-22 17:00:34Z suehring
77	! Further revision of last commit in order to avoid any side effects when
78	! albedo type is not set in namelist and default albedo type changes.
79	!
80	! 4024 2019-06-12 14:06:46Z suehring
81	! Bugfix in albedo initialization, caused crashes in rrtmg calls
82	!
83	! 3987 2019-05-22 09:52:13Z kanani
84	! Introduce alternative switch for debug output during timestepping
85	!
86	! 3964 2019-05-09 09:48:32Z suehring
87	! In a nested child domain, distinguish between soil moisture and temperature
88	! initialization from parent via dynamic input file. Further, initialize soil
89	! moisture/temperature from dynamic input file only when initialization via
90	! 'inifor' is desired.
91	!
92	! 3943 2019-05-02 09:50:41Z maronga
93	! Removed extra blank character
94	!
95	! 3941 2019-04-30 09:48:33Z suehring
96	! Check that at least one surface type is set at surface element.
97	!
98	! 3933 2019-04-25 12:33:20Z kanani
99	! Remove unused subroutine and allocation of pt_2m, this is done in surface_mod
100	! now (surfaces%pt_2m)
101	!
102	!
103	! Changes related to global restructuring of location messages and introduction
104	! of additional debug messages
105	!
106	! 3881 2019-04-10 09:31:22Z suehring
107	! Bugfix in level 3 initialization of pavement albedo type and pavement
108	! emissivity
109	!
110	! 3868 2019-04-08 11:52:36Z suehring
111	! More strict limitation of roughness length when it is in the order of the
112	! vertical grid spacing
113	!
114	! 3856 2019-04-03 11:06:59Z suehring
115	! Bugfix in lsm_init in case no surface-fractions are provided
116	!
117	! 3847 2019-04-01 14:51:44Z suehring
118	! Adjust message-call for checks that are especially carried out locally.
119	!
120	! 3832 2019-03-28 13:16:58Z raasch
121	! instrumented with openmp directives
122	!
123	! 3786 2019-03-06 16:58:03Z raasch
124	! further unused variables removed
125	!
126	! 3767 2019-02-27 08:18:02Z raasch
127	! unused variable for file index removed from rrd-subroutines parameter list
128	!
129	! 3715 2019-02-04 17:34:55Z suehring
130	! Revise check for saturation moisture
131	!
132	! 3710 2019-01-30 18:11:19Z suehring
133	! Check if soil-, water-, pavement- and vegetation types are set within a valid
134	! range.
135	!
136	! 3692 2019-01-23 14:45:49Z suehring
137	! Revise check for soil moisture higher than its saturation value
138	!
139	! 3685 2019-01-21 01:02:11Z knoop
140	! Some interface calls moved to module_interface + cleanup
141	!
142	! 3677 2019-01-17 09:07:06Z moh.hefny
143	! Removed most_method
144	!
145	! 3655 2019-01-07 16:51:22Z knoop
146	! nopointer option removed
147	!
148	! 1496 2014-12-02 17:25:50Z maronga
149	! Initial revision
150	!
151	!
152	! Description:
153	! ------------
154	!> Land surface model, consisting of a solver for the energy balance at the
155	!> surface and a multi layer soil scheme. The scheme is similar to the TESSEL
156	!> scheme implemented in the ECMWF IFS model, with modifications according to
157	!> H-TESSEL. The implementation is based on the formulation implemented in the
158	!> DALES and UCLA-LES models.
159	!>
160	!> @todo Extensive verification energy-balance solver for vertical surfaces,
161	!> e.g. parametrization of r_a
162	!> @todo Revise single land-surface processes for vertical surfaces, e.g.
163	!> treatment of humidity, etc.
164	!> @todo Consider partial absorption of the net shortwave radiation by the
165	!> skin layer.
166	!> @todo Improve surface water parameterization
167	!> @todo Invert indices (running from -3 to 0. Currently: nzb_soil=0,
168	!> nzt_soil=3)).
169	!> @todo Implement surface runoff model (required when performing long-term LES
170	!> with considerable precipitation.
171	!> @todo Revise calculation of f2 when wilting point is non-constant in the
172	!> soil
173	!> @todo Allow for zero soil moisture (currently, it is set to wilting point)
174	!> @note No time step criterion is required as long as the soil layers do not
175	!> become too thin.
176	!> @todo Attention, pavement_subpars_1/2 are hardcoded to 8 levels, in case
177	!> more levels are used this may cause an potential bug
178	!> @todo Routine calc_q_surface required?
179	!> @todo Allow for precipitation water to enter pavements that are semi-pervious
180	!------------------------------------------------------------------------------!
181	MODULE land_surface_model_mod
182
183	USE arrays_3d, &
184	ONLY: hyp, pt, prr, q, q_p, ql, vpt, u, v, w, hyrho, exner, d_exner
185
186	USE basic_constants_and_equations_mod, &
187	ONLY: c_p, g, lv_d_cp, l_v, kappa, magnus, rho_l, r_d, r_v, rd_d_rv
188
189	USE calc_mean_profile_mod, &
190	ONLY: calc_mean_profile
191
192	USE control_parameters, &
193	ONLY: cloud_droplets, &
194	coupling_char, &
195	coupling_start_time, &
196	debug_output, debug_output_timestep, debug_string, &
197	dt_3d, &
198	end_time, humidity, intermediate_timestep_count, &
199	initializing_actions, intermediate_timestep_count_max, &
200	land_surface, max_masks, pt_surface, &
201	rho_surface, spinup, spinup_pt_mean, spinup_time, &
202	surface_pressure, timestep_scheme, tsc, &
203	time_since_reference_point
204
205	USE cpulog, &
206	ONLY: cpu_log, log_point_s
207
208	USE indices, &
209	ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb
210
211	USE bulk_cloud_model_mod, &
212	ONLY: bulk_cloud_model, precipitation
213
214	USE netcdf_data_input_mod, &
215	ONLY : building_type_f, &
216	char_fill, &
217	char_lod, &
218	check_existence, &
219	close_input_file, &
220	get_attribute, &
221	get_dimension_length, &
222	get_variable, &
223	init_3d, &
224	input_file_dynamic, &
225	input_pids_dynamic, &
226	input_pids_static, &
227	inquire_num_variables, &
228	inquire_variable_names, &
229	num_var_pids, &
230	open_read_file, &
231	pids_id, &
232	pavement_pars_f, &
233	pavement_subsurface_pars_f, &
234	pavement_type_f, &
235	root_area_density_lsm_f, &
236	soil_pars_f, &
237	soil_type_f, &
238	surface_fraction_f, &
239	vars_pids, &
240	vegetation_pars_f, &
241	vegetation_type_f, &
242	water_pars_f, &
243	water_type_f
244
245	USE kinds
246
247	USE pegrid
248
249	USE radiation_model_mod, &
250	ONLY: albedo, albedo_type, emissivity, force_radiation_call, &
251	radiation, radiation_scheme, unscheduled_radiation_calls
252
253	USE statistics, &
254	ONLY: hom, statistic_regions
255
256	USE surface_mod, &
257	ONLY : ind_pav_green, ind_veg_wall, ind_wat_win, &
258	surf_lsm_h, surf_lsm_v, surf_type, surface_restore_elements
259
260	IMPLICIT NONE
261
262	TYPE surf_type_lsm
263	REAL(wp), DIMENSION(:), ALLOCATABLE :: var_1d !< 1D prognostic variable
264	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var_2d !< 2D prognostic variable
265	END TYPE surf_type_lsm
266
267	!
268	!-- LSM model constants
269
270	REAL(wp), PARAMETER :: &
271	b_ch = 6.04_wp, & ! Clapp & Hornberger exponent
272	lambda_h_dry = 0.19_wp, & ! heat conductivity for dry soil (W/m/K)
273	lambda_h_sm = 3.44_wp, & ! heat conductivity of the soil matrix (W/m/K)
274	lambda_h_water = 0.57_wp, & ! heat conductivity of water (W/m/K)
275	psi_sat = -0.388_wp, & ! soil matrix potential at saturation
276	rho_c_soil = 2.19E6_wp, & ! volumetric heat capacity of soil (J/m3/K)
277	rho_c_water = 4.20E6_wp, & ! volumetric heat capacity of water (J/m3/K)
278	m_max_depth = 0.0002_wp ! Maximum capacity of the water reservoir on a flat surface (leaf/bare soil) (m)
279
280
281	REAL(wp), DIMENSION(0:7), PARAMETER :: dz_soil_default = & ! default soil layer configuration
282	(/ 0.01_wp, 0.02_wp, 0.04_wp, &
283	0.06_wp, 0.14_wp, 0.26_wp, &
284	0.54_wp, 1.86_wp/)
285
286	REAL(wp), DIMENSION(0:3), PARAMETER :: dz_soil_ref = & ! reference four layer soil configuration used for estimating the root fractions
287	(/ 0.07_wp, 0.21_wp, 0.72_wp, &
288	1.89_wp /)
289
290	REAL(wp), DIMENSION(0:3), PARAMETER :: zs_ref = & ! reference four layer soil configuration used for estimating the root fractions
291	(/ 0.07_wp, 0.28_wp, 1.0_wp, &
292	2.89_wp /)
293
294
295	!
296	!-- LSM variables
297	CHARACTER(10) :: surface_type = 'netcdf' !< general classification. Allowed are:
298	!< 'vegetation', 'pavement', ('building'),
299	!< 'water', and 'netcdf'
300
301
302
303	INTEGER(iwp) :: nzb_soil = 0, & !< bottom of the soil model (Earth's surface)
304	nzt_soil = 7, & !< top of the soil model
305	nzt_pavement = 0, & !< top of the pavement within the soil
306	nzs = 8, & !< number of soil layers
307	pavement_depth_level = 0, & !< default NAMELIST nzt_pavement
308	pavement_type = 1, & !< default NAMELIST pavement_type
309	soil_type = 3, & !< default NAMELIST soil_type
310	vegetation_type = 2, & !< default NAMELIST vegetation_type
311	water_type = 1 !< default NAMELISt water_type
312
313
314
315	LOGICAL :: conserve_water_content = .TRUE., & !< open or closed bottom surface for the soil model
316	constant_roughness = .FALSE., & !< use fixed/dynamic roughness lengths for water surfaces
317	force_radiation_call_l = .FALSE., & !< flag to force calling of radiation routine
318	aero_resist_kray = .TRUE. !< flag to control parametrization of aerodynamic resistance at vertical surface elements
319
320	! value 9999999.9_wp -> generic available or user-defined value must be set
321	! otherwise -> no generic variable and user setting is optional
322	REAL(wp) :: alpha_vangenuchten = 9999999.9_wp, & !< NAMELIST alpha_vg
323	canopy_resistance_coefficient = 9999999.9_wp, & !< NAMELIST g_d
324	c_surface = 9999999.9_wp, & !< Surface (skin) heat capacity (J/m2/K)
325	deep_soil_temperature = 9999999.9_wp, & !< Deep soil temperature (bottom boundary condition)
326	drho_l_lv, & !< (rho_l * l_v)**-1
327	field_capacity = 9999999.9_wp, & !< NAMELIST m_fc
328	f_shortwave_incoming = 9999999.9_wp, & !< NAMELIST f_sw_in
329	hydraulic_conductivity = 9999999.9_wp, & !< NAMELIST gamma_w_sat
330	ke = 0.0_wp, & !< Kersten number
331	lambda_h_sat = 0.0_wp, & !< heat conductivity for saturated soil (W/m/K)
332	lambda_surface_stable = 9999999.9_wp, & !< NAMELIST lambda_surface_s (W/m2/K)
333	lambda_surface_unstable = 9999999.9_wp, & !< NAMELIST lambda_surface_u (W/m2/K)
334	leaf_area_index = 9999999.9_wp, & !< NAMELIST lai
335	l_vangenuchten = 9999999.9_wp, & !< NAMELIST l_vg
336	min_canopy_resistance = 9999999.9_wp, & !< NAMELIST r_canopy_min
337	min_soil_resistance = 50.0_wp, & !< NAMELIST r_soil_min
338	m_total = 0.0_wp, & !< weighted total water content of the soil (m3/m3)
339	n_vangenuchten = 9999999.9_wp, & !< NAMELIST n_vg
340	pavement_heat_capacity = 9999999.9_wp, & !< volumetric heat capacity of pavement (e.g. roads) (J/m3/K)
341	pavement_heat_conduct = 9999999.9_wp, & !< heat conductivity for pavements (e.g. roads) (W/m/K)
342	q_s = 0.0_wp, & !< saturation water vapor mixing ratio
343	residual_moisture = 9999999.9_wp, & !< NAMELIST m_res
344	rho_cp, & !< rho_surface * cp
345	rho_lv, & !< rho_ocean * l_v
346	saturation_moisture = 9999999.9_wp, & !< NAMELIST m_sat
347	skip_time_do_lsm = 0.0_wp, & !< LSM is not called before this time
348	vegetation_coverage = 9999999.9_wp, & !< NAMELIST c_veg
349	water_temperature = 9999999.9_wp, & !< water temperature
350	wilting_point = 9999999.9_wp, & !< NAMELIST m_wilt
351	z0_vegetation = 9999999.9_wp, & !< NAMELIST z0 (lsm_par)
352	z0h_vegetation = 9999999.9_wp, & !< NAMELIST z0h (lsm_par)
353	z0q_vegetation = 9999999.9_wp, & !< NAMELIST z0q (lsm_par)
354	z0_pavement = 9999999.9_wp, & !< NAMELIST z0 (lsm_par)
355	z0h_pavement = 9999999.9_wp, & !< NAMELIST z0h (lsm_par)
356	z0q_pavement = 9999999.9_wp, & !< NAMELIST z0q (lsm_par)
357	z0_water = 9999999.9_wp, & !< NAMELIST z0 (lsm_par)
358	z0h_water = 9999999.9_wp, & !< NAMELIST z0h (lsm_par)
359	z0q_water = 9999999.9_wp !< NAMELIST z0q (lsm_par)
360
361
362	REAL(wp), DIMENSION(:), ALLOCATABLE :: ddz_soil_center, & !< 1/dz_soil_center
363	ddz_soil, & !< 1/dz_soil
364	dz_soil_center, & !< soil grid spacing (center-center)
365	zs, & !< depth of the temperature/moisute levels
366	root_extr !< root extraction
367
368
369
370	REAL(wp), DIMENSION(0:20) :: root_fraction = 9999999.9_wp, & !< (NAMELIST) distribution of root surface area to the individual soil layers
371	soil_moisture = 0.0_wp, & !< NAMELIST soil moisture content (m3/m3)
372	soil_temperature = 9999999.9_wp, & !< NAMELIST soil temperature (K) +1
373	dz_soil = 9999999.9_wp, & !< (NAMELIST) soil layer depths (spacing)
374	zs_layer = 9999999.9_wp !< soil layer depths (edge)
375
376	TYPE(surf_type_lsm), POINTER :: t_soil_h, & !< Soil temperature (K), horizontal surface elements
377	t_soil_h_p, & !< Prog. soil temperature (K), horizontal surface elements
378	m_soil_h, & !< Soil moisture (m3/m3), horizontal surface elements
379	m_soil_h_p !< Prog. soil moisture (m3/m3), horizontal surface elements
380
381	TYPE(surf_type_lsm), TARGET :: t_soil_h_1, & !<
382	t_soil_h_2, & !<
383	m_soil_h_1, & !<
384	m_soil_h_2 !<
385
386	TYPE(surf_type_lsm), DIMENSION(:), POINTER :: &
387	t_soil_v, & !< Soil temperature (K), vertical surface elements
388	t_soil_v_p, & !< Prog. soil temperature (K), vertical surface elements
389	m_soil_v, & !< Soil moisture (m3/m3), vertical surface elements
390	m_soil_v_p !< Prog. soil moisture (m3/m3), vertical surface elements
391
392	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::&
393	t_soil_v_1, & !<
394	t_soil_v_2, & !<
395	m_soil_v_1, & !<
396	m_soil_v_2 !<
397
398	TYPE(surf_type_lsm), POINTER :: t_surface_h, & !< surface temperature (K), horizontal surface elements
399	t_surface_h_p, & !< progn. surface temperature (K), horizontal surface elements
400	m_liq_h, & !< liquid water reservoir (m), horizontal surface elements
401	m_liq_h_p !< progn. liquid water reservoir (m), horizontal surface elements
402
403	TYPE(surf_type_lsm), TARGET :: t_surface_h_1, & !<
404	t_surface_h_2, & !<
405	m_liq_h_1, & !<
406	m_liq_h_2 !<
407
408	TYPE(surf_type_lsm), DIMENSION(:), POINTER :: &
409	t_surface_v, & !< surface temperature (K), vertical surface elements
410	t_surface_v_p, & !< progn. surface temperature (K), vertical surface elements
411	m_liq_v, & !< liquid water reservoir (m), vertical surface elements
412	m_liq_v_p !< progn. liquid water reservoir (m), vertical surface elements
413
414	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: &
415	t_surface_v_1, & !<
416	t_surface_v_2, & !<
417	m_liq_v_1, & !<
418	m_liq_v_2 !<
419
420	REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: m_liq_av
421
422	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: t_soil_av, & !< Average of t_soil
423	m_soil_av !< Average of m_soil
424
425	TYPE(surf_type_lsm), TARGET :: tm_liq_h_m !< liquid water reservoir tendency (m), horizontal surface elements
426	TYPE(surf_type_lsm), TARGET :: tt_surface_h_m !< surface temperature tendency (K), horizontal surface elements
427	TYPE(surf_type_lsm), TARGET :: tt_soil_h_m !< t_soil storage array, horizontal surface elements
428	TYPE(surf_type_lsm), TARGET :: tm_soil_h_m !< m_soil storage array, horizontal surface elements
429
430	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_liq_v_m !< liquid water reservoir tendency (m), vertical surface elements
431	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_surface_v_m !< surface temperature tendency (K), vertical surface elements
432	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_soil_v_m !< t_soil storage array, vertical surface elements
433	TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_soil_v_m !< m_soil storage array, vertical surface elements
434
435	!
436	!-- Energy balance variables
437	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
438	c_liq_av, & !< average of c_liq
439	c_soil_av, & !< average of c_soil
440	c_veg_av, & !< average of c_veg
441	lai_av, & !< average of lai
442	qsws_liq_av, & !< average of qsws_liq
443	qsws_soil_av, & !< average of qsws_soil
444	qsws_veg_av, & !< average of qsws_veg
445	r_s_av !< average of r_s
446
447	!
448	!-- Predefined Land surface classes (vegetation_type)
449	CHARACTER(26), DIMENSION(0:18), PARAMETER :: vegetation_type_name = (/ &
450	'user defined ', & ! 0
451	'bare soil ', & ! 1
452	'crops, mixed farming ', & ! 2
453	'short grass ', & ! 3
454	'evergreen needleleaf trees', & ! 4
455	'deciduous needleleaf trees', & ! 5
456	'evergreen broadleaf trees ', & ! 6
457	'deciduous broadleaf trees ', & ! 7
458	'tall grass ', & ! 8
459	'desert ', & ! 9
460	'tundra ', & ! 10
461	'irrigated crops ', & ! 11
462	'semidesert ', & ! 12
463	'ice caps and glaciers ', & ! 13
464	'bogs and marshes ', & ! 14
465	'evergreen shrubs ', & ! 15
466	'deciduous shrubs ', & ! 16
467	'mixed forest/woodland ', & ! 17
468	'interrupted forest ' & ! 18
469	/)
470
471	!
472	!-- Soil model classes (soil_type)
473	CHARACTER(12), DIMENSION(0:6), PARAMETER :: soil_type_name = (/ &
474	'user defined', & ! 0
475	'coarse ', & ! 1
476	'medium ', & ! 2
477	'medium-fine ', & ! 3
478	'fine ', & ! 4
479	'very fine ', & ! 5
480	'organic ' & ! 6
481	/)
482
483	!
484	!-- Pavement classes
485	CHARACTER(29), DIMENSION(0:15), PARAMETER :: pavement_type_name = (/ &
486	'user defined ', & ! 0
487	'asphalt/concrete mix ', & ! 1
488	'asphalt (asphalt concrete) ', & ! 2
489	'concrete (Portland concrete) ', & ! 3
490	'sett ', & ! 4
491	'paving stones ', & ! 5
492	'cobblestone ', & ! 6
493	'metal ', & ! 7
494	'wood ', & ! 8
495	'gravel ', & ! 9
496	'fine gravel ', & ! 10
497	'pebblestone ', & ! 11
498	'woodchips ', & ! 12
499	'tartan (sports) ', & ! 13
500	'artifical turf (sports) ', & ! 14
501	'clay (sports) ' & ! 15
502	/)
503
504	!
505	!-- Water classes
506	CHARACTER(12), DIMENSION(0:5), PARAMETER :: water_type_name = (/ &
507	'user defined', & ! 0
508	'lake ', & ! 1
509	'river ', & ! 2
510	'ocean ', & ! 3
511	'pond ', & ! 4
512	'fountain ' & ! 5
513	/)
514
515	!
516	!-- Land surface parameters according to the respective classes (vegetation_type)
517	INTEGER(iwp) :: ind_v_rc_min = 0 !< index for r_canopy_min in vegetation_pars
518	INTEGER(iwp) :: ind_v_rc_lai = 1 !< index for LAI in vegetation_pars
519	INTEGER(iwp) :: ind_v_c_veg = 2 !< index for c_veg in vegetation_pars
520	INTEGER(iwp) :: ind_v_gd = 3 !< index for g_d in vegetation_pars
521	INTEGER(iwp) :: ind_v_z0 = 4 !< index for z0 in vegetation_pars
522	INTEGER(iwp) :: ind_v_z0qh = 5 !< index for z0h / z0q in vegetation_pars
523	INTEGER(iwp) :: ind_v_lambda_s = 6 !< index for lambda_s_s in vegetation_pars
524	INTEGER(iwp) :: ind_v_lambda_u = 7 !< index for lambda_s_u in vegetation_pars
525	INTEGER(iwp) :: ind_v_f_sw_in = 8 !< index for f_sw_in in vegetation_pars
526	INTEGER(iwp) :: ind_v_c_surf = 9 !< index for c_surface in vegetation_pars
527	INTEGER(iwp) :: ind_v_at = 10 !< index for albedo_type in vegetation_pars
528	INTEGER(iwp) :: ind_v_emis = 11 !< index for emissivity in vegetation_pars
529
530	INTEGER(iwp) :: ind_w_temp = 0 !< index for temperature in water_pars
531	INTEGER(iwp) :: ind_w_z0 = 1 !< index for z0 in water_pars
532	INTEGER(iwp) :: ind_w_z0h = 2 !< index for z0h in water_pars
533	INTEGER(iwp) :: ind_w_lambda_s = 3 !< index for lambda_s_s in water_pars
534	INTEGER(iwp) :: ind_w_lambda_u = 4 !< index for lambda_s_u in water_pars
535	INTEGER(iwp) :: ind_w_at = 5 !< index for albedo type in water_pars
536	INTEGER(iwp) :: ind_w_emis = 6 !< index for emissivity in water_pars
537
538	INTEGER(iwp) :: ind_p_z0 = 0 !< index for z0 in pavement_pars
539	INTEGER(iwp) :: ind_p_z0h = 1 !< index for z0h in pavement_pars
540	INTEGER(iwp) :: ind_p_at = 2 !< index for albedo type in pavement_pars
541	INTEGER(iwp) :: ind_p_emis = 3 !< index for emissivity in pavement_pars
542	INTEGER(iwp) :: ind_p_lambda_h = 0 !< index for lambda_h in pavement_subsurface_pars
543	INTEGER(iwp) :: ind_p_rho_c = 1 !< index for rho_c in pavement_pars
544	!
545	!-- Land surface parameters
546	!-- r_canopy_min, lai, c_veg, g_d z0, z0h, lambda_s_s, lambda_s_u, f_sw_in, c_surface, albedo_type, emissivity
547	REAL(wp), DIMENSION(0:11,1:18), PARAMETER :: vegetation_pars = RESHAPE( (/ &
548	0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, 0.005_wp, 0.5E-4_wp, 0.0_wp, 0.0_wp, 0.00_wp, 0.00_wp, 17.0_wp, 0.94_wp, & ! 1
549	180.0_wp, 3.00_wp, 1.00_wp, 0.00_wp, 0.10_wp, 0.001_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 2.0_wp, 0.95_wp, & ! 2
550	110.0_wp, 2.00_wp, 1.00_wp, 0.00_wp, 0.03_wp, 0.3E-4_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 5.0_wp, 0.95_wp, & ! 3
551	500.0_wp, 5.00_wp, 1.00_wp, 0.03_wp, 2.00_wp, 2.00_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 6.0_wp, 0.97_wp, & ! 4
552	500.0_wp, 5.00_wp, 1.00_wp, 0.03_wp, 2.00_wp, 2.00_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 8.0_wp, 0.97_wp, & ! 5
553	175.0_wp, 5.00_wp, 1.00_wp, 0.03_wp, 2.00_wp, 2.00_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 9.0_wp, 0.97_wp, & ! 6
554	240.0_wp, 6.00_wp, 0.99_wp, 0.13_wp, 2.00_wp, 2.00_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 7.0_wp, 0.97_wp, & ! 7
555	100.0_wp, 2.00_wp, 0.70_wp, 0.00_wp, 0.47_wp, 0.47E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 10.0_wp, 0.97_wp, & ! 8
556	250.0_wp, 0.05_wp, 0.00_wp, 0.00_wp, 0.013_wp, 0.013E-2_wp, 15.0_wp, 15.0_wp, 0.00_wp, 0.00_wp, 11.0_wp, 0.94_wp, & ! 9
557	80.0_wp, 1.00_wp, 0.50_wp, 0.00_wp, 0.034_wp, 0.034E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 13.0_wp, 0.97_wp, & ! 10
558	180.0_wp, 3.00_wp, 1.00_wp, 0.00_wp, 0.5_wp, 0.50E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 2.0_wp, 0.97_wp, & ! 11
559	150.0_wp, 0.50_wp, 0.10_wp, 0.00_wp, 0.17_wp, 0.17E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 11.0_wp, 0.97_wp, & ! 12
560	0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, 1.3E-3_wp, 1.3E-4_wp, 58.0_wp, 58.0_wp, 0.00_wp, 0.00_wp, 14.0_wp, 0.97_wp, & ! 13
561	240.0_wp, 4.00_wp, 0.60_wp, 0.00_wp, 0.83_wp, 0.83E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 3.0_wp, 0.97_wp, & ! 14
562	225.0_wp, 3.00_wp, 0.50_wp, 0.00_wp, 0.10_wp, 0.10E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 4.0_wp, 0.97_wp, & ! 15
563	225.0_wp, 1.50_wp, 0.50_wp, 0.00_wp, 0.25_wp, 0.25E-2_wp, 10.0_wp, 10.0_wp, 0.05_wp, 0.00_wp, 5.0_wp, 0.97_wp, & ! 16
564	250.0_wp, 5.00_wp, 1.00_wp, 0.03_wp, 2.00_wp, 2.00_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 10.0_wp, 0.97_wp, & ! 17
565	175.0_wp, 2.50_wp, 1.00_wp, 0.03_wp, 1.10_wp, 1.10_wp, 20.0_wp, 15.0_wp, 0.03_wp, 0.00_wp, 7.0_wp, 0.97_wp & ! 18
566	/), (/ 12, 18 /) )
567
568
569	!
570	!-- Root distribution for default soil layer configuration (sum = 1)
571	!-- level 1 - level 4 according to zs_ref
572	REAL(wp), DIMENSION(0:3,1:18), PARAMETER :: root_distribution = RESHAPE( (/ &
573	1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 1
574	0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & ! 2
575	0.35_wp, 0.38_wp, 0.23_wp, 0.04_wp, & ! 3
576	0.26_wp, 0.39_wp, 0.29_wp, 0.06_wp, & ! 4
577	0.26_wp, 0.38_wp, 0.29_wp, 0.07_wp, & ! 5
578	0.24_wp, 0.38_wp, 0.31_wp, 0.07_wp, & ! 6
579	0.25_wp, 0.34_wp, 0.27_wp, 0.14_wp, & ! 7
580	0.27_wp, 0.27_wp, 0.27_wp, 0.09_wp, & ! 8
581	1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 9
582	0.47_wp, 0.45_wp, 0.08_wp, 0.00_wp, & ! 10
583	0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & ! 11
584	0.17_wp, 0.31_wp, 0.33_wp, 0.19_wp, & ! 12
585	0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 13
586	0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp, & ! 14
587	0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 15
588	0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 16
589	0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp, & ! 17
590	0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp & ! 18
591	/), (/ 4, 18 /) )
592
593	!
594	!-- Soil parameters according to the following porosity classes (soil_type)
595
596	!
597	!-- Soil parameters alpha_vg, l_vg, n_vg, gamma_w_sat, m_sat, m_fc, m_wilt, m_res
598	REAL(wp), DIMENSION(0:7,1:6), PARAMETER :: soil_pars = RESHAPE( (/ &
599	3.83_wp, 1.250_wp, 1.38_wp, 6.94E-6_wp, 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp,& ! 1
600	3.14_wp, -2.342_wp, 1.28_wp, 1.16E-6_wp, 0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp,& ! 2
601	0.83_wp, -0.588_wp, 1.25_wp, 0.26E-6_wp, 0.430_wp, 0.383_wp, 0.133_wp, 0.010_wp,& ! 3
602	3.67_wp, -1.977_wp, 1.10_wp, 2.87E-6_wp, 0.520_wp, 0.448_wp, 0.279_wp, 0.010_wp,& ! 4
603	2.65_wp, 2.500_wp, 1.10_wp, 1.74E-6_wp, 0.614_wp, 0.541_wp, 0.335_wp, 0.010_wp,& ! 5
604	1.30_wp, 0.400_wp, 1.20_wp, 0.93E-6_wp, 0.766_wp, 0.663_wp, 0.267_wp, 0.010_wp & ! 6
605	/), (/ 8, 6 /) )
606
607
608	!
609	!-- TO BE FILLED
610	!-- Pavement parameters z0, z0h, albedo_type, emissivity
611	REAL(wp), DIMENSION(0:3,1:15), PARAMETER :: pavement_pars = RESHAPE( (/ &
612	5.0E-2_wp, 5.0E-4_wp, 18.0_wp, 0.97_wp, & ! 1
613	5.0E-2_wp, 5.0E-4_wp, 19.0_wp, 0.94_wp, & ! 2
614	1.0E-2_wp, 1.0E-4_wp, 20.0_wp, 0.98_wp, & ! 3
615	1.0E-2_wp, 1.0E-4_wp, 21.0_wp, 0.93_wp, & ! 4
616	1.0E-2_wp, 1.0E-4_wp, 22.0_wp, 0.97_wp, & ! 5
617	1.0E-2_wp, 1.0E-4_wp, 23.0_wp, 0.97_wp, & ! 6
618	1.0E-2_wp, 1.0E-4_wp, 24.0_wp, 0.97_wp, & ! 7
619	1.0E-2_wp, 1.0E-4_wp, 25.0_wp, 0.94_wp, & ! 8
620	1.0E-2_wp, 1.0E-4_wp, 26.0_wp, 0.98_wp, & ! 9
621	1.0E-2_wp, 1.0E-4_wp, 27.0_wp, 0.93_wp, & ! 10
622	1.0E-2_wp, 1.0E-4_wp, 28.0_wp, 0.97_wp, & ! 11
623	1.0E-2_wp, 1.0E-4_wp, 29.0_wp, 0.97_wp, & ! 12
624	1.0E-2_wp, 1.0E-4_wp, 30.0_wp, 0.97_wp, & ! 13
625	1.0E-2_wp, 1.0E-4_wp, 31.0_wp, 0.94_wp, & ! 14
626	1.0E-2_wp, 1.0E-4_wp, 32.0_wp, 0.98_wp & ! 15
627	/), (/ 4, 15 /) )
628	!
629	!-- Pavement subsurface parameters part 1: thermal conductivity (W/m/K)
630	!-- 0.0-0.01, 0.01-0.03, 0.03-0.07, 0.07-0.15, 0.15-0.30, 0.30-0.50, 0.50-1.25, 1.25-3.00
631	REAL(wp), DIMENSION(0:7,1:15), PARAMETER :: pavement_subsurface_pars_1 = RESHAPE( (/ &
632	0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 9999999.9_wp, 9999999.9_wp, & ! 1
633	0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 0.75_wp, 9999999.9_wp, 9999999.9_wp, & ! 2
634	0.89_wp, 0.89_wp, 0.89_wp, 0.89_wp, 0.89_wp, 0.89_wp, 9999999.9_wp, 9999999.9_wp, & ! 3
635	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 4
636	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 5
637	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 6
638	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 7
639	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 8
640	0.70_wp, 0.70_wp, 0.70_wp, 0.70_wp, 0.70_wp, 0.70_wp, 9999999.9_wp, 9999999.9_wp, & ! 9
641	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 10
642	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 11
643	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 12
644	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 13
645	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp, & ! 14
646	1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 1.00_wp, 9999999.9_wp, 9999999.9_wp & ! 15
647	/), (/ 8, 15 /) )
648
649	!
650	!-- Pavement subsurface parameters part 2: volumetric heat capacity (J/m3/K)
651	!-- 0.0-0.01, 0.01-0.03, 0.03-0.07, 0.07-0.15, 0.15-0.30, 0.30-0.50, 0.50-1.25, 1.25-3.00
652	REAL(wp), DIMENSION(0:7,1:15), PARAMETER :: pavement_subsurface_pars_2 = RESHAPE( (/ &
653	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 1
654	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 2
655	1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 1.76E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 3
656	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 4
657	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 5
658	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 6
659	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 7
660	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 8
661	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 9
662	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 10
663	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 11
664	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 12
665	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 13
666	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp, & ! 14
667	1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp & ! 15
668	/), (/ 8, 15 /) )
669
670	!
671	!-- TO BE FILLED
672	!-- Water parameters temperature, z0, z0h, albedo_type, emissivity,
673	REAL(wp), DIMENSION(0:6,1:5), PARAMETER :: water_pars = RESHAPE( (/ &
674	283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 1
675	283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 2
676	283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 3
677	283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 4
678	283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp & ! 5
679	/), (/ 7, 5 /) )
680
681	SAVE
682
683
684	PRIVATE
685
686
687	!
688	!-- Public functions
689	PUBLIC lsm_boundary_condition, lsm_check_data_output, &
690	lsm_check_data_output_pr, &
691	lsm_check_parameters, lsm_define_netcdf_grid, lsm_3d_data_averaging,&
692	lsm_data_output_2d, lsm_data_output_3d, lsm_energy_balance, &
693	lsm_header, lsm_init, lsm_init_arrays, lsm_parin, lsm_soil_model, &
694	lsm_swap_timelevel, lsm_rrd_local, lsm_wrd_local
695	! !vegetat
696	!-- Public parameters, constants and initial values
697	PUBLIC aero_resist_kray, skip_time_do_lsm
698
699	!
700	!-- Public grid variables
701	PUBLIC nzb_soil, nzs, nzt_soil, zs
702
703	!
704	!-- Public prognostic variables
705	PUBLIC m_soil_h, t_soil_h
706
707	INTERFACE lsm_boundary_condition
708	MODULE PROCEDURE lsm_boundary_condition
709	END INTERFACE lsm_boundary_condition
710
711	INTERFACE lsm_check_data_output
712	MODULE PROCEDURE lsm_check_data_output
713	END INTERFACE lsm_check_data_output
714
715	INTERFACE lsm_check_data_output_pr
716	MODULE PROCEDURE lsm_check_data_output_pr
717	END INTERFACE lsm_check_data_output_pr
718
719	INTERFACE lsm_check_parameters
720	MODULE PROCEDURE lsm_check_parameters
721	END INTERFACE lsm_check_parameters
722
723	INTERFACE lsm_3d_data_averaging
724	MODULE PROCEDURE lsm_3d_data_averaging
725	END INTERFACE lsm_3d_data_averaging
726
727	INTERFACE lsm_data_output_2d
728	MODULE PROCEDURE lsm_data_output_2d
729	END INTERFACE lsm_data_output_2d
730
731	INTERFACE lsm_data_output_3d
732	MODULE PROCEDURE lsm_data_output_3d
733	END INTERFACE lsm_data_output_3d
734
735	INTERFACE lsm_define_netcdf_grid
736	MODULE PROCEDURE lsm_define_netcdf_grid
737	END INTERFACE lsm_define_netcdf_grid
738
739	INTERFACE lsm_energy_balance
740	MODULE PROCEDURE lsm_energy_balance
741	END INTERFACE lsm_energy_balance
742
743	INTERFACE lsm_header
744	MODULE PROCEDURE lsm_header
745	END INTERFACE lsm_header
746
747	INTERFACE lsm_init
748	MODULE PROCEDURE lsm_init
749	END INTERFACE lsm_init
750
751	INTERFACE lsm_init_arrays
752	MODULE PROCEDURE lsm_init_arrays
753	END INTERFACE lsm_init_arrays
754
755	INTERFACE lsm_parin
756	MODULE PROCEDURE lsm_parin
757	END INTERFACE lsm_parin
758
759	INTERFACE lsm_soil_model
760	MODULE PROCEDURE lsm_soil_model
761	END INTERFACE lsm_soil_model
762
763	INTERFACE lsm_swap_timelevel
764	MODULE PROCEDURE lsm_swap_timelevel
765	END INTERFACE lsm_swap_timelevel
766
767	INTERFACE lsm_rrd_local
768	MODULE PROCEDURE lsm_rrd_local
769	END INTERFACE lsm_rrd_local
770
771	INTERFACE lsm_wrd_local
772	MODULE PROCEDURE lsm_wrd_local
773	END INTERFACE lsm_wrd_local
774
775	CONTAINS
776
777
778	!------------------------------------------------------------------------------!
779	! Description:
780	! ------------
781	!> Set internal Neumann boundary condition at outer soil grid points
782	!> for temperature and humidity.
783	!------------------------------------------------------------------------------!
784	SUBROUTINE lsm_boundary_condition
785
786	IMPLICIT NONE
787
788	INTEGER(iwp) :: i !< grid index x-direction
789	INTEGER(iwp) :: ioff !< offset index x-direction indicating location of soil grid point
790	INTEGER(iwp) :: j !< grid index y-direction
791	INTEGER(iwp) :: joff !< offset index x-direction indicating location of soil grid point
792	INTEGER(iwp) :: k !< grid index z-direction
793	INTEGER(iwp) :: koff !< offset index x-direction indicating location of soil grid point
794	INTEGER(iwp) :: l !< running index surface-orientation
795	INTEGER(iwp) :: m !< running index surface elements
796
797	koff = surf_lsm_h%koff
798	DO m = 1, surf_lsm_h%ns
799	i = surf_lsm_h%i(m)
800	j = surf_lsm_h%j(m)
801	k = surf_lsm_h%k(m)
802	pt(k+koff,j,i) = pt(k,j,i)
803	ENDDO
804
805	DO l = 0, 3
806	ioff = surf_lsm_v(l)%ioff
807	joff = surf_lsm_v(l)%joff
808	DO m = 1, surf_lsm_v(l)%ns
809	i = surf_lsm_v(l)%i(m)
810	j = surf_lsm_v(l)%j(m)
811	k = surf_lsm_v(l)%k(m)
812	pt(k,j+joff,i+ioff) = pt(k,j,i)
813	ENDDO
814	ENDDO
815	!
816	!-- In case of humidity, set boundary conditions also for q and vpt.
817	IF ( humidity ) THEN
818	koff = surf_lsm_h%koff
819	DO m = 1, surf_lsm_h%ns
820	i = surf_lsm_h%i(m)
821	j = surf_lsm_h%j(m)
822	k = surf_lsm_h%k(m)
823	q(k+koff,j,i) = q(k,j,i)
824	vpt(k+koff,j,i) = vpt(k,j,i)
825	ENDDO
826
827	DO l = 0, 3
828	ioff = surf_lsm_v(l)%ioff
829	joff = surf_lsm_v(l)%joff
830	DO m = 1, surf_lsm_v(l)%ns
831	i = surf_lsm_v(l)%i(m)
832	j = surf_lsm_v(l)%j(m)
833	k = surf_lsm_v(l)%k(m)
834	q(k,j+joff,i+ioff) = q(k,j,i)
835	vpt(k,j+joff,i+ioff) = vpt(k,j,i)
836	ENDDO
837	ENDDO
838	ENDIF
839
840	END SUBROUTINE lsm_boundary_condition
841
842	!------------------------------------------------------------------------------!
843	! Description:
844	! ------------
845	!> Check data output for land surface model
846	!------------------------------------------------------------------------------!
847	SUBROUTINE lsm_check_data_output( var, unit, i, ilen, k )
848
849
850	USE control_parameters, &
851	ONLY: data_output, message_string
852
853	IMPLICIT NONE
854
855	CHARACTER (LEN=*) :: unit !<
856	CHARACTER (LEN=*) :: var !<
857
858	INTEGER(iwp) :: i
859	INTEGER(iwp) :: ilen
860	INTEGER(iwp) :: k
861
862	SELECT CASE ( TRIM( var ) )
863
864	CASE ( 'm_soil' )
865	IF ( .NOT. land_surface ) THEN
866	message_string = 'output of "' // TRIM( var ) // '" requi' // &
867	'res land_surface = .TRUE.'
868	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
869	ENDIF
870	unit = 'm3/m3'
871
872	CASE ( 't_soil' )
873	IF ( .NOT. land_surface ) THEN
874	message_string = 'output of "' // TRIM( var ) // '" requi' // &
875	'res land_surface = .TRUE.'
876	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
877	ENDIF
878	unit = 'K'
879
880	CASE ( 'lai', 'c_liq', 'c_soil', 'c_veg', 'm_liq*', &
881	'qsws_liq', 'qsws_soil', 'qsws_veg', 'r_s' )
882	IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN
883	message_string = 'illegal value for data_output: "' // &
884	TRIM( var ) // '" & only 2d-horizontal ' // &
885	'cross sections are allowed for this value'
886	CALL message( 'lsm_check_data_output', 'PA0111', 1, 2, 0, 6, 0 )
887	ENDIF
888	IF ( TRIM( var ) == 'lai*' .AND. .NOT. land_surface ) THEN
889	message_string = 'output of "' // TRIM( var ) // '" requi' // &
890	'res land_surface = .TRUE.'
891	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
892	ENDIF
893	IF ( TRIM( var ) == 'c_liq*' .AND. .NOT. land_surface ) THEN
894	message_string = 'output of "' // TRIM( var ) // '" requi' // &
895	'res land_surface = .TRUE.'
896	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
897	ENDIF
898	IF ( TRIM( var ) == 'c_soil*' .AND. .NOT. land_surface ) THEN
899	message_string = 'output of "' // TRIM( var ) // '" requi' // &
900	'res land_surface = .TRUE.'
901	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
902	ENDIF
903	IF ( TRIM( var ) == 'c_veg*' .AND. .NOT. land_surface ) THEN
904	message_string = 'output of "' // TRIM( var ) // '" requi' // &
905	'res land_surface = .TRUE.'
906	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
907	ENDIF
908	IF ( TRIM( var ) == 'm_liq*' .AND. .NOT. land_surface ) THEN
909	message_string = 'output of "' // TRIM( var ) // '" requi' // &
910	'res land_surface = .TRUE.'
911	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
912	ENDIF
913	IF ( TRIM( var ) == 'qsws_liq*' .AND. .NOT. land_surface ) &
914	THEN
915	message_string = 'output of "' // TRIM( var ) // '" requi' // &
916	'res land_surface = .TRUE.'
917	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
918	ENDIF
919	IF ( TRIM( var ) == 'qsws_soil*' .AND. .NOT. land_surface ) &
920	THEN
921	message_string = 'output of "' // TRIM( var ) // '" requi' // &
922	'res land_surface = .TRUE.'
923	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
924	ENDIF
925	IF ( TRIM( var ) == 'qsws_veg*' .AND. .NOT. land_surface ) &
926	THEN
927	message_string = 'output of "' // TRIM( var ) // '" requi' // &
928	'res land_surface = .TRUE.'
929	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
930	ENDIF
931	IF ( TRIM( var ) == 'r_s*' .AND. .NOT. land_surface ) &
932	THEN
933	message_string = 'output of "' // TRIM( var ) // '" requi' // &
934	'res land_surface = .TRUE.'
935	CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 )
936	ENDIF
937
938	IF ( TRIM( var ) == 'lai*' ) unit = 'none'
939	IF ( TRIM( var ) == 'c_liq*' ) unit = 'none'
940	IF ( TRIM( var ) == 'c_soil*') unit = 'none'
941	IF ( TRIM( var ) == 'c_veg*' ) unit = 'none'
942	IF ( TRIM( var ) == 'm_liq*' ) unit = 'm'
943	IF ( TRIM( var ) == 'qsws_liq*' ) unit = 'W/m2'
944	IF ( TRIM( var ) == 'qsws_soil*' ) unit = 'W/m2'
945	IF ( TRIM( var ) == 'qsws_veg*' ) unit = 'W/m2'
946	IF ( TRIM( var ) == 'r_s*') unit = 's/m'
947
948	CASE DEFAULT
949	unit = 'illegal'
950
951	END SELECT
952
953
954	END SUBROUTINE lsm_check_data_output
955
956
957
958	!------------------------------------------------------------------------------!
959	! Description:
960	! ------------
961	!> Check data output of profiles for land surface model
962	!------------------------------------------------------------------------------!
963	SUBROUTINE lsm_check_data_output_pr( variable, var_count, unit, dopr_unit )
964
965	USE control_parameters, &
966	ONLY: data_output_pr, message_string
967
968	USE indices
969
970	USE profil_parameter
971
972	USE statistics
973
974	IMPLICIT NONE
975
976	CHARACTER (LEN=*) :: unit !<
977	CHARACTER (LEN=*) :: variable !<
978	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
979
980	INTEGER(iwp) :: var_count !<
981
982	SELECT CASE ( TRIM( variable ) )
983
984	CASE ( 't_soil', '#t_soil' )
985	IF ( .NOT. land_surface ) THEN
986	message_string = 'data_output_pr = ' // &
987	TRIM( data_output_pr(var_count) ) // ' is' // &
988	'not implemented for land_surface = .FALSE.'
989	CALL message( 'lsm_check_data_output_pr', 'PA0402', 1, 2, 0, 6, 0 )
990	ELSE
991	dopr_index(var_count) = 89
992	dopr_unit = 'K'
993	hom(0:nzs-1,2,89,:) = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
994	IF ( data_output_pr(var_count)(1:1) == '#' ) THEN
995	dopr_initial_index(var_count) = 90
996	hom(0:nzs-1,2,90,:) = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
997	data_output_pr(var_count) = data_output_pr(var_count)(2:)
998	ENDIF
999	unit = dopr_unit
1000	ENDIF
1001
1002	CASE ( 'm_soil', '#m_soil' )
1003	IF ( .NOT. land_surface ) THEN
1004	message_string = 'data_output_pr = ' // &
1005	TRIM( data_output_pr(var_count) ) // ' is' // &
1006	' not implemented for land_surface = .FALSE.'
1007	CALL message( 'lsm_check_data_output_pr', 'PA0402', 1, 2, 0, 6, 0 )
1008	ELSE
1009	dopr_index(var_count) = 91
1010	dopr_unit = 'm3/m3'
1011	hom(0:nzs-1,2,91,:) = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
1012	IF ( data_output_pr(var_count)(1:1) == '#' ) THEN
1013	dopr_initial_index(var_count) = 92
1014	hom(0:nzs-1,2,92,:) = SPREAD( - zs(nzb_soil:nzt_soil), 2, statistic_regions+1 )
1015	data_output_pr(var_count) = data_output_pr(var_count)(2:)
1016	ENDIF
1017	unit = dopr_unit
1018	ENDIF
1019
1020
1021	CASE DEFAULT
1022	unit = 'illegal'
1023
1024	END SELECT
1025
1026
1027	END SUBROUTINE lsm_check_data_output_pr
1028
1029
1030	!------------------------------------------------------------------------------!
1031	! Description:
1032	! ------------
1033	!> Check parameters routine for land surface model
1034	!------------------------------------------------------------------------------!
1035	SUBROUTINE lsm_check_parameters
1036
1037	USE control_parameters, &
1038	ONLY: bc_pt_b, bc_q_b, constant_flux_layer, message_string
1039
1040
1041	IMPLICIT NONE
1042
1043	INTEGER(iwp) :: i !< running index, x-dimension
1044	INTEGER(iwp) :: j !< running index, y-dimension
1045	INTEGER(iwp) :: k !< running index, z-dimension
1046
1047	LOGICAL :: dynamic_soil_input_parent !< flag indicating the presence of a dynamic input file for the parent
1048
1049	!
1050	!-- Check for a valid setting of surface_type. The default value is 'netcdf'.
1051	!-- In that case, the surface types are read from NetCDF file
1052	IF ( TRIM( surface_type ) /= 'vegetation' .AND. &
1053	TRIM( surface_type ) /= 'pavement' .AND. &
1054	TRIM( surface_type ) /= 'water' .AND. &
1055	TRIM( surface_type ) /= 'netcdf' ) THEN
1056	message_string = 'unknown surface type: surface_type = "' // &
1057	TRIM( surface_type ) // '"'
1058	CALL message( 'lsm_check_parameters', 'PA0019', 1, 2, 0, 6, 0 )
1059	ENDIF
1060
1061	!
1062	!-- Dirichlet boundary conditions are required as the surface fluxes are
1063	!-- calculated from the temperature/humidity gradients in the land surface
1064	!-- model
1065	IF ( bc_pt_b == 'neumann' .OR. bc_q_b == 'neumann' ) THEN
1066	message_string = 'lsm requires setting of'// &
1067	'bc_pt_b = "dirichlet" and '// &
1068	'bc_q_b = "dirichlet"'
1069	CALL message( 'lsm_check_parameters', 'PA0399', 1, 2, 0, 6, 0 )
1070	ENDIF
1071
1072	IF ( .NOT. constant_flux_layer ) THEN
1073	message_string = 'lsm requires '// &
1074	'constant_flux_layer = .T.'
1075	CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 )
1076	ENDIF
1077
1078	IF ( .NOT. radiation ) THEN
1079	message_string = 'lsm requires '// &
1080	'the radiation model to be switched on'
1081	CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 )
1082	ENDIF
1083	!
1084	!-- Check if soil types are set within a valid range.
1085	IF ( TRIM( surface_type ) == 'vegetation' .OR. &
1086	TRIM( surface_type ) == 'pavement' ) THEN
1087	IF ( soil_type < LBOUND( soil_pars, 2 ) .AND. &
1088	soil_type > UBOUND( soil_pars, 2 ) ) THEN
1089	WRITE( message_string, * ) 'soil_type = ', soil_type, ' is out ' // &
1090	'of the valid range'
1091	CALL message( 'lsm_check_parameters', 'PA0452', 2, 2, 0, 6, 0 )
1092	ENDIF
1093	ENDIF
1094	IF ( TRIM( surface_type ) == 'netcdf' ) THEN
1095	IF ( soil_type_f%from_file ) THEN
1096	DO i = nxl, nxr
1097	DO j = nys, nyn
1098	IF ( soil_type_f%var_2d(j,i) /= soil_type_f%fill .AND. &
1099	( soil_type_f%var_2d(j,i) < LBOUND( soil_pars, 2 ) .OR. &
1100	soil_type_f%var_2d(j,i) > UBOUND( soil_pars, 2 ) ) ) THEN
1101	WRITE( message_string, * ) 'soil_type = is out of ' // &
1102	'the valid range at (j,i) = ', j, i
1103	CALL message( 'lsm_check_parameters', 'PA0452', &
1104	2, 2, myid, 6, 0 )
1105	ENDIF
1106	ENDDO
1107	ENDDO
1108	ENDIF
1109	ENDIF
1110	!
1111	!-- Check if vegetation types are set within a valid range.
1112	IF ( TRIM( surface_type ) == 'vegetation' ) THEN
1113	IF ( vegetation_type < LBOUND( vegetation_pars, 2 ) .AND. &
1114	vegetation_type > UBOUND( vegetation_pars, 2 ) ) THEN
1115	WRITE( message_string, * ) 'vegetation_type = ', vegetation_type, &
1116	' is out of the valid range'
1117	CALL message( 'lsm_check_parameters', 'PA0526', 2, 2, 0, 6, 0 )
1118	ENDIF
1119	ENDIF
1120	IF ( TRIM( surface_type ) == 'netcdf' ) THEN
1121	IF ( vegetation_type_f%from_file ) THEN
1122	DO i = nxl, nxr
1123	DO j = nys, nyn
1124	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND.&
1125	( vegetation_type_f%var(j,i) < LBOUND( vegetation_pars, 2 ) .OR.&
1126	vegetation_type_f%var(j,i) > UBOUND( vegetation_pars, 2 ) ) ) &
1127	THEN
1128	WRITE( message_string, * ) 'vegetation_type = is out of ' //&
1129	'the valid range at (j,i) = ', j, i
1130	CALL message( 'lsm_check_parameters', 'PA0526', &
1131	2, 2, myid, 6, 0 )
1132	ENDIF
1133	ENDDO
1134	ENDDO
1135	ENDIF
1136	ENDIF
1137	!
1138	!-- Check if pavement types are set within a valid range.
1139	IF ( TRIM( surface_type ) == 'pavement' ) THEN
1140	IF ( pavement_type < LBOUND( pavement_pars, 2 ) .AND. &
1141	pavement_type > UBOUND( pavement_pars, 2 ) ) THEN
1142	WRITE( message_string, * ) 'pavement_type = ', pavement_type, &
1143	' is out of the valid range'
1144	CALL message( 'lsm_check_parameters', 'PA0527', 2, 2, 0, 6, 0 )
1145	ENDIF
1146	ENDIF
1147	IF ( TRIM( surface_type ) == 'netcdf' ) THEN
1148	IF ( pavement_type_f%from_file ) THEN
1149	DO i = nxl, nxr
1150	DO j = nys, nyn
1151	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. &
1152	( pavement_type_f%var(j,i) < LBOUND( pavement_pars, 2 ) .OR. &
1153	pavement_type_f%var(j,i) > UBOUND( pavement_pars, 2 ) ) ) THEN
1154	WRITE( message_string, * ) 'pavement_type = is out of ' // &
1155	'the valid range at (j,i) = ', j, i
1156	CALL message( 'lsm_check_parameters', 'PA0527', &
1157	2, 2, myid, 6, 0 )
1158	ENDIF
1159	ENDDO
1160	ENDDO
1161	ENDIF
1162	ENDIF
1163	!
1164	!-- Check if water types are set within a valid range.
1165	IF ( TRIM( surface_type ) == 'water' ) THEN
1166	IF ( water_type < LBOUND( water_pars, 2 ) .AND. &
1167	water_type > UBOUND( water_pars, 2 ) ) THEN
1168	WRITE( message_string, * ) 'water_type = ', water_type, &
1169	' is out of the valid range'
1170	CALL message( 'lsm_check_parameters', 'PA0528', 2, 2, 0, 6, 0 )
1171	ENDIF
1172	ENDIF
1173	IF ( TRIM( surface_type ) == 'netcdf' ) THEN
1174	IF ( water_type_f%from_file ) THEN
1175	DO i = nxl, nxr
1176	DO j = nys, nyn
1177	IF ( water_type_f%var(j,i) /= water_type_f%fill .AND. &
1178	( water_type_f%var(j,i) < LBOUND( water_pars, 2 ) .OR. &
1179	water_type_f%var(j,i) > UBOUND( water_pars, 2 ) ) ) THEN
1180	WRITE( message_string, * ) 'water_type = is out of ' // &
1181	'the valid range at (j,i) = ', j, i
1182	CALL message( 'lsm_check_parameters', 'PA0528', &
1183	2, 2, myid, 6, 0 )
1184	ENDIF
1185	ENDDO
1186	ENDDO
1187	ENDIF
1188	ENDIF
1189	!
1190	!-- Check further settings for consistency.
1191	IF ( TRIM( surface_type ) == 'vegetation' ) THEN
1192
1193	IF ( vegetation_type == 0 ) THEN
1194	IF ( min_canopy_resistance == 9999999.9_wp ) THEN
1195	message_string = 'vegetation_type = 0 (user defined)'// &
1196	'requires setting of min_canopy_resistance'// &
1197	'/= 9999999.9'
1198	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1199	ENDIF
1200
1201	IF ( leaf_area_index == 9999999.9_wp ) THEN
1202	message_string = 'vegetation_type = 0 (user_defined)'// &
1203	'requires setting of leaf_area_index'// &
1204	'/= 9999999.9'
1205	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1206	ENDIF
1207
1208	IF ( vegetation_coverage == 9999999.9_wp ) THEN
1209	message_string = 'vegetation_type = 0 (user_defined)'// &
1210	'requires setting of vegetation_coverage'// &
1211	'/= 9999999.9'
1212	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1213	ENDIF
1214
1215	IF ( canopy_resistance_coefficient == 9999999.9_wp) THEN
1216	message_string = 'vegetation_type = 0 (user_defined)'// &
1217	'requires setting of'// &
1218	'canopy_resistance_coefficient /= 9999999.9'
1219	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1220	ENDIF
1221
1222	IF ( lambda_surface_stable == 9999999.9_wp ) THEN
1223	message_string = 'vegetation_type = 0 (user_defined)'// &
1224	'requires setting of lambda_surface_stable'// &
1225	'/= 9999999.9'
1226	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1227	ENDIF
1228
1229	IF ( lambda_surface_unstable == 9999999.9_wp ) THEN
1230	message_string = 'vegetation_type = 0 (user_defined)'// &
1231	'requires setting of lambda_surface_unstable'// &
1232	'/= 9999999.9'
1233	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1234	ENDIF
1235
1236	IF ( f_shortwave_incoming == 9999999.9_wp ) THEN
1237	message_string = 'vegetation_type = 0 (user_defined)'// &
1238	'requires setting of f_shortwave_incoming'// &
1239	'/= 9999999.9'
1240	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1241	ENDIF
1242
1243	IF ( z0_vegetation == 9999999.9_wp ) THEN
1244	message_string = 'vegetation_type = 0 (user_defined)'// &
1245	'requires setting of z0_vegetation'// &
1246	'/= 9999999.9'
1247	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1248	ENDIF
1249
1250	IF ( z0h_vegetation == 9999999.9_wp ) THEN
1251	message_string = 'vegetation_type = 0 (user_defined)'// &
1252	'requires setting of z0h_vegetation'// &
1253	'/= 9999999.9'
1254	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1255	ENDIF
1256	ENDIF
1257
1258	IF ( vegetation_type == 1 ) THEN
1259	IF ( vegetation_coverage /= 9999999.9_wp .AND. vegetation_coverage &
1260	/= 0.0_wp ) THEN
1261	message_string = 'vegetation_type = 1 (bare soil)'// &
1262	' requires vegetation_coverage = 0'
1263	CALL message( 'lsm_check_parameters', 'PA0294', 1, 2, 0, 6, 0 )
1264	ENDIF
1265	ENDIF
1266
1267	ENDIF
1268
1269	IF ( TRIM( surface_type ) == 'water' ) THEN
1270
1271	IF ( water_type == 0 ) THEN
1272
1273	IF ( z0_water == 9999999.9_wp ) THEN
1274	message_string = 'water_type = 0 (user_defined)'// &
1275	'requires setting of z0_water'// &
1276	'/= 9999999.9'
1277	CALL message( 'lsm_check_parameters', 'PA0415', 1, 2, 0, 6, 0 )
1278	ENDIF
1279
1280	IF ( z0h_water == 9999999.9_wp ) THEN
1281	message_string = 'water_type = 0 (user_defined)'// &
1282	'requires setting of z0h_water'// &
1283	'/= 9999999.9'
1284	CALL message( 'lsm_check_parameters', 'PA0392', 1, 2, 0, 6, 0 )
1285	ENDIF
1286
1287	IF ( water_temperature == 9999999.9_wp ) THEN
1288	message_string = 'water_type = 0 (user_defined)'// &
1289	'requires setting of water_temperature'// &
1290	'/= 9999999.9'
1291	CALL message( 'lsm_check_parameters', 'PA0379', 1, 2, 0, 6, 0 )
1292	ENDIF
1293
1294	ENDIF
1295
1296	ENDIF
1297
1298	IF ( TRIM( surface_type ) == 'pavement' ) THEN
1299
1300	IF ( ANY( dz_soil /= 9999999.9_wp ) .AND. pavement_type /= 0 ) THEN
1301	message_string = 'non-default setting of dz_soil '// &
1302	'does not allow to use pavement_type /= 0)'
1303	CALL message( 'lsm_check_parameters', 'PA0341', 1, 2, 0, 6, 0 )
1304	ENDIF
1305
1306	IF ( pavement_type == 0 ) THEN
1307
1308	IF ( z0_pavement == 9999999.9_wp ) THEN
1309	message_string = 'pavement_type = 0 (user_defined)'// &
1310	'requires setting of z0_pavement'// &
1311	'/= 9999999.9'
1312	CALL message( 'lsm_check_parameters', 'PA0352', 1, 2, 0, 6, 0 )
1313	ENDIF
1314
1315	IF ( z0h_pavement == 9999999.9_wp ) THEN
1316	message_string = 'pavement_type = 0 (user_defined)'// &
1317	'requires setting of z0h_pavement'// &
1318	'/= 9999999.9'
1319	CALL message( 'lsm_check_parameters', 'PA0353', 1, 2, 0, 6, 0 )
1320	ENDIF
1321
1322	IF ( pavement_heat_conduct == 9999999.9_wp ) THEN
1323	message_string = 'pavement_type = 0 (user_defined)'// &
1324	'requires setting of pavement_heat_conduct'// &
1325	'/= 9999999.9'
1326	CALL message( 'lsm_check_parameters', 'PA0342', 1, 2, 0, 6, 0 )
1327	ENDIF
1328
1329	IF ( pavement_heat_capacity == 9999999.9_wp ) THEN
1330	message_string = 'pavement_type = 0 (user_defined)'// &
1331	'requires setting of pavement_heat_capacity'// &
1332	'/= 9999999.9'
1333	CALL message( 'lsm_check_parameters', 'PA0139', 1, 2, 0, 6, 0 )
1334	ENDIF
1335
1336	IF ( pavement_depth_level == 0 ) THEN
1337	message_string = 'pavement_type = 0 (user_defined)'// &
1338	'requires setting of pavement_depth_level'// &
1339	'/= 0'
1340	CALL message( 'lsm_check_parameters', 'PA0474', 1, 2, 0, 6, 0 )
1341	ENDIF
1342
1343	ENDIF
1344
1345	ENDIF
1346
1347	IF ( TRIM( surface_type ) == 'netcdf' ) THEN
1348	!
1349	!-- MS: Some problme here, after calling message everythings stucks at
1350	!-- MPI_FINALIZE call.
1351	IF ( ANY( pavement_type_f%var /= pavement_type_f%fill ) .AND. &
1352	ANY( dz_soil /= 9999999.9_wp ) ) THEN
1353	message_string = 'pavement-surfaces are not allowed in ' // &
1354	'combination with a non-default setting of dz_soil'
1355	CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 )
1356	ENDIF
1357	ENDIF
1358
1359	!
1360	!-- Temporary message as long as NetCDF input is not available
1361	IF ( TRIM( surface_type ) == 'netcdf' .AND. .NOT. input_pids_static ) &
1362	THEN
1363	message_string = 'surface_type = netcdf requires static input file.'
1364	CALL message( 'lsm_check_parameters', 'PA0465', 1, 2, 0, 6, 0 )
1365	ENDIF
1366
1367	IF ( soil_type == 0 .AND. .NOT. input_pids_static ) THEN
1368
1369	IF ( alpha_vangenuchten == 9999999.9_wp ) THEN
1370	message_string = 'soil_type = 0 (user_defined)'// &
1371	'requires setting of alpha_vangenuchten'// &
1372	'/= 9999999.9'
1373	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1374	ENDIF
1375
1376	IF ( l_vangenuchten == 9999999.9_wp ) THEN
1377	message_string = 'soil_type = 0 (user_defined)'// &
1378	'requires setting of l_vangenuchten'// &
1379	'/= 9999999.9'
1380	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1381	ENDIF
1382
1383	IF ( n_vangenuchten == 9999999.9_wp ) THEN
1384	message_string = 'soil_type = 0 (user_defined)'// &
1385	'requires setting of n_vangenuchten'// &
1386	'/= 9999999.9'
1387	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1388	ENDIF
1389
1390	IF ( hydraulic_conductivity == 9999999.9_wp ) THEN
1391	message_string = 'soil_type = 0 (user_defined)'// &
1392	'requires setting of hydraulic_conductivity'// &
1393	'/= 9999999.9'
1394	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1395	ENDIF
1396
1397	IF ( saturation_moisture == 9999999.9_wp ) THEN
1398	message_string = 'soil_type = 0 (user_defined)'// &
1399	'requires setting of saturation_moisture'// &
1400	'/= 9999999.9'
1401	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1402	ENDIF
1403
1404	IF ( field_capacity == 9999999.9_wp ) THEN
1405	message_string = 'soil_type = 0 (user_defined)'// &
1406	'requires setting of field_capacity'// &
1407	'/= 9999999.9'
1408	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1409	ENDIF
1410
1411	IF ( wilting_point == 9999999.9_wp ) THEN
1412	message_string = 'soil_type = 0 (user_defined)'// &
1413	'requires setting of wilting_point'// &
1414	'/= 9999999.9'
1415	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1416	ENDIF
1417
1418	IF ( residual_moisture == 9999999.9_wp ) THEN
1419	message_string = 'soil_type = 0 (user_defined)'// &
1420	'requires setting of residual_moisture'// &
1421	'/= 9999999.9'
1422	CALL message( 'lsm_check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
1423	ENDIF
1424
1425	ENDIF
1426
1427
1428	!!! these checks are not needed for water surfaces??
1429
1430	!
1431	!-- Determine number of soil layers to be used and check whether an appropriate
1432	!-- root fraction is prescribed
1433	nzb_soil = 0
1434	nzt_soil = -1
1435	IF ( ALL( dz_soil == 9999999.9_wp ) ) THEN
1436	nzt_soil = 7
1437	dz_soil(nzb_soil:nzt_soil) = dz_soil_default
1438	ELSE
1439	DO k = 0, 19
1440	IF ( dz_soil(k) /= 9999999.9_wp ) THEN
1441	nzt_soil = nzt_soil + 1
1442	ENDIF
1443	ENDDO
1444	ENDIF
1445	nzs = nzt_soil + 1
1446
1447	!
1448	!-- Check whether valid soil temperatures are prescribed. Only check this if
1449	!-- no dynamic soil is not initialized with dynamic input.
1450	!-- In a nested case, check whether there is a dynamic input file for the
1451	!-- child (input_pids_dynamic = .T.) or one for the parent (inquire without
1452	!-- coupling_char.
1453	INQUIRE( FILE = TRIM( input_file_dynamic ), &
1454	EXIST = dynamic_soil_input_parent )
1455
1456	IF ( .NOT. input_pids_dynamic .AND. .NOT. dynamic_soil_input_parent ) THEN
1457	IF ( COUNT( soil_temperature /= 9999999.9_wp ) /= nzs ) THEN
1458	WRITE( message_string, * ) &
1459	'number of soil layers (', nzs, ') does not',&
1460	' match to the number of layers specified', &
1461	' in soil_temperature (', COUNT( &
1462	soil_temperature /= 9999999.9_wp ), ')'
1463	CALL message( 'lsm_check_parameters', 'PA0471', 1, 2, 0, 6, 0 )
1464	ENDIF
1465
1466	IF ( deep_soil_temperature == 9999999.9_wp ) THEN
1467	message_string = 'deep_soil_temperature is not set but must be'// &
1468	'/= 9999999.9'
1469	CALL message( 'lsm_check_parameters', 'PA0472', 1, 2, 0, 6, 0 )
1470	ENDIF
1471	ENDIF
1472
1473	!
1474	!-- Check whether the sum of all root fractions equals one
1475	IF ( .NOT. vegetation_type_f%from_file ) THEN
1476	IF ( vegetation_type == 0 ) THEN
1477	IF ( SUM( root_fraction(nzb_soil:nzt_soil) ) /= 1.0_wp ) THEN
1478	message_string = 'vegetation_type = 0 (user_defined)'// &
1479	'requires setting of root_fraction'// &
1480	'/= 9999999.9 and SUM(root_fraction) = 1'
1481	CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
1482	ENDIF
1483	ENDIF
1484	ENDIF
1485	!
1486	!-- Calculate grid spacings. Temperature and moisture are defined at
1487	!-- the center of the soil layers, whereas gradients/fluxes are
1488	!-- defined at the edges (_layer)
1489	!
1490	!-- Allocate global 1D arrays
1491	ALLOCATE ( ddz_soil_center(nzb_soil:nzt_soil) )
1492	ALLOCATE ( ddz_soil(nzb_soil:nzt_soil+1) )
1493	ALLOCATE ( dz_soil_center(nzb_soil:nzt_soil) )
1494	ALLOCATE ( zs(nzb_soil:nzt_soil+1) )
1495
1496
1497	zs(nzb_soil) = 0.5_wp * dz_soil(nzb_soil)
1498	zs_layer(nzb_soil) = dz_soil(nzb_soil)
1499
1500	DO k = nzb_soil+1, nzt_soil
1501	zs_layer(k) = zs_layer(k-1) + dz_soil(k)
1502	zs(k) = (zs_layer(k) + zs_layer(k-1)) * 0.5_wp
1503	ENDDO
1504
1505	dz_soil(nzt_soil+1) = zs_layer(nzt_soil) + dz_soil(nzt_soil)
1506	zs(nzt_soil+1) = zs_layer(nzt_soil) + 0.5_wp * dz_soil(nzt_soil)
1507
1508	DO k = nzb_soil, nzt_soil-1
1509	dz_soil_center(k) = zs(k+1) - zs(k)
1510	IF ( dz_soil_center(k) <= 0.0_wp ) THEN
1511	message_string = 'invalid soil layer configuration found ' // &
1512	'(dz_soil_center(k) <= 0.0)'
1513	CALL message( 'lsm_rrd_local', 'PA0140', 1, 2, 0, 6, 0 )
1514	ENDIF
1515	ENDDO
1516
1517	dz_soil_center(nzt_soil) = zs_layer(k-1) + dz_soil(k) - zs(nzt_soil)
1518
1519	ddz_soil_center = 1.0_wp / dz_soil_center
1520	ddz_soil(nzb_soil:nzt_soil) = 1.0_wp / dz_soil(nzb_soil:nzt_soil)
1521
1522
1523
1524	END SUBROUTINE lsm_check_parameters
1525
1526	!------------------------------------------------------------------------------!
1527	! Description:
1528	! ------------
1529	!> Solver for the energy balance at the surface.
1530	!------------------------------------------------------------------------------!
1531	SUBROUTINE lsm_energy_balance( horizontal, l )
1532
1533	USE pegrid
1534	USE radiation_model_mod, ONLY: rad_lw_out
1535
1536	IMPLICIT NONE
1537
1538	INTEGER(iwp) :: i !< running index
1539	INTEGER(iwp) :: i_off !< offset to determine index of surface element, seen from atmospheric grid point, for x
1540	INTEGER(iwp) :: j !< running index
1541	INTEGER(iwp) :: j_off !< offset to determine index of surface element, seen from atmospheric grid point, for y
1542	INTEGER(iwp) :: k !< running index
1543	INTEGER(iwp) :: k_off !< offset to determine index of surface element, seen from atmospheric grid point, for z
1544	INTEGER(iwp) :: ks !< running index
1545	INTEGER(iwp) :: l !< surface-facing index
1546	INTEGER(iwp) :: m !< running index concerning wall elements
1547
1548	LOGICAL :: horizontal !< Flag indicating horizontal or vertical surfaces
1549
1550	REAL(wp) :: c_surface_tmp,& !< temporary variable for storing the volumetric heat capacity of the surface
1551	f1, & !< resistance correction term 1
1552	f2, & !< resistance correction term 2
1553	f3, & !< resistance correction term 3
1554	m_min, & !< minimum soil moisture
1555	e, & !< water vapour pressure
1556	e_s, & !< water vapour saturation pressure
1557	e_s_dt, & !< derivate of e_s with respect to T
1558	tend, & !< tendency
1559	dq_s_dt, & !< derivate of q_s with respect to T
1560	coef_1, & !< coef. for prognostic equation
1561	coef_2, & !< coef. for prognostic equation
1562	f_qsws, & !< factor for qsws
1563	f_qsws_veg, & !< factor for qsws_veg
1564	f_qsws_soil, & !< factor for qsws_soil
1565	f_qsws_liq, & !< factor for qsws_liq
1566	f_shf, & !< factor for shf
1567	lambda_soil, & !< Thermal conductivity of the uppermost soil layer (W/m2/K)
1568	lambda_surface, & !< Current value of lambda_surface (W/m2/K)
1569	m_liq_max !< maxmimum value of the liq. water reservoir
1570
1571	TYPE(surf_type_lsm), POINTER :: surf_t_surface
1572	TYPE(surf_type_lsm), POINTER :: surf_t_surface_p
1573	TYPE(surf_type_lsm), POINTER :: surf_tt_surface_m
1574	TYPE(surf_type_lsm), POINTER :: surf_m_liq
1575	TYPE(surf_type_lsm), POINTER :: surf_m_liq_p
1576	TYPE(surf_type_lsm), POINTER :: surf_tm_liq_m
1577
1578	TYPE(surf_type_lsm), POINTER :: surf_m_soil
1579	TYPE(surf_type_lsm), POINTER :: surf_t_soil
1580
1581	TYPE(surf_type), POINTER :: surf !< surface-date type variable
1582
1583
1584	IF ( debug_output_timestep ) THEN
1585	WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
1586	CALL debug_message( debug_string, 'start' )
1587	ENDIF
1588
1589	IF ( horizontal ) THEN
1590	surf => surf_lsm_h
1591
1592	surf_t_surface => t_surface_h
1593	surf_t_surface_p => t_surface_h_p
1594	surf_tt_surface_m => tt_surface_h_m
1595	surf_m_liq => m_liq_h
1596	surf_m_liq_p => m_liq_h_p
1597	surf_tm_liq_m => tm_liq_h_m
1598	surf_m_soil => m_soil_h
1599	surf_t_soil => t_soil_h
1600	ELSE
1601	surf => surf_lsm_v(l)
1602
1603	surf_t_surface => t_surface_v(l)
1604	surf_t_surface_p => t_surface_v_p(l)
1605	surf_tt_surface_m => tt_surface_v_m(l)
1606	surf_m_liq => m_liq_v(l)
1607	surf_m_liq_p => m_liq_v_p(l)
1608	surf_tm_liq_m => tm_liq_v_m(l)
1609	surf_m_soil => m_soil_v(l)
1610	surf_t_soil => t_soil_v(l)
1611	ENDIF
1612
1613	!
1614	!-- Index offset of surface element point with respect to adjoining
1615	!-- atmospheric grid point
1616	k_off = surf%koff
1617	j_off = surf%joff
1618	i_off = surf%ioff
1619
1620	!$OMP PARALLEL PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, &
1621	!$OMP& c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s, &
1622	!$OMP& f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt, &
1623	!$OMP& coef_1, coef_2, tend)
1624	!$OMP DO SCHEDULE (STATIC)
1625	DO m = 1, surf%ns
1626
1627	i = surf%i(m)
1628	j = surf%j(m)
1629	k = surf%k(m)
1630
1631	!
1632	!-- Define heat conductivity between surface and soil depending on surface
1633	!-- type. For vegetation, a skin layer parameterization is used. The new
1634	!-- parameterization uses a combination of two conductivities: a constant
1635	!-- conductivity for the skin layer, and a conductivity according to the
1636	!-- uppermost soil layer. For bare soil and pavements, no skin layer is
1637	!-- applied. In these cases, the temperature is assumed to be constant
1638	!-- between the surface and the first soil layer. The heat conductivity is
1639	!-- then derived from the soil/pavement properties.
1640	!-- For water surfaces, the conductivity is already set to 1E10.
1641	!-- Moreover, the heat capacity is set. For bare soil the heat capacity is
1642	!-- the capacity of the uppermost soil layer, for pavement it is that of
1643	!-- the material involved.
1644
1645	!
1646	!-- for vegetation type surfaces, the thermal conductivity of the soil is
1647	!-- needed
1648
1649	IF ( surf%vegetation_surface(m) ) THEN
1650
1651	lambda_h_sat = lambda_h_sm*(1.0_wp - surf%m_sat(nzb_soil,m)) &
1652	lambda_h_water ** surf_m_soil%var_2d(nzb_soil,m)
1653
1654	ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(nzb_soil,m) / &
1655	surf%m_sat(nzb_soil,m) ) )
1656
1657	lambda_soil = (ke * (lambda_h_sat - lambda_h_dry) + lambda_h_dry ) &
1658	* ddz_soil(nzb_soil) * 2.0_wp
1659
1660	!
1661	!-- When bare soil is set without a thermal conductivity (no skin layer),
1662	!-- a heat capacity is that of the soil layer, otherwise it is a
1663	!-- combination of the conductivities from the skin and the soil layer
1664	IF ( surf%lambda_surface_s(m) == 0.0_wp ) THEN
1665	surf%c_surface(m) = (rho_c_soil * (1.0_wp - surf%m_sat(nzb_soil,m))&
1666	+ rho_c_water * surf_m_soil%var_2d(nzb_soil,m) ) &
1667	* dz_soil(nzb_soil) * 0.5_wp
1668	lambda_surface = lambda_soil
1669
1670	ELSE IF ( surf_t_surface%var_1d(m) >= surf_t_soil%var_2d(nzb_soil,m))&
1671	THEN
1672	lambda_surface = surf%lambda_surface_s(m) * lambda_soil &
1673	/ ( surf%lambda_surface_s(m) + lambda_soil )
1674	ELSE
1675
1676	lambda_surface = surf%lambda_surface_u(m) * lambda_soil &
1677	/ ( surf%lambda_surface_u(m) + lambda_soil )
1678	ENDIF
1679	ELSE
1680	lambda_surface = surf%lambda_surface_s(m)
1681	ENDIF
1682
1683	!
1684	!-- Set heat capacity of the skin/surface. It is ususally zero when a skin
1685	!-- layer is used, and non-zero otherwise.
1686	c_surface_tmp = surf%c_surface(m)
1687
1688	!
1689	!-- First step: calculate aerodyamic resistance. As pt, us, ts
1690	!-- are not available for the prognostic time step, data from the last
1691	!-- time step is used here. Note that this formulation is the
1692	!-- equivalent to the ECMWF formulation using drag coefficients
1693	! IF ( bulk_cloud_model ) THEN
1694	! pt1 = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
1695	! qv1 = q(k,j,i) - ql(k,j,i)
1696	! ELSEIF ( cloud_droplets ) THEN
1697	! pt1 = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
1698	! qv1 = q(k,j,i)
1699	! ELSE
1700	! pt1 = pt(k,j,i)
1701	! IF ( humidity ) THEN
1702	! qv1 = q(k,j,i)
1703	! ELSE
1704	! qv1 = 0.0_wp
1705	! ENDIF
1706	! ENDIF
1707	!
1708	!-- Calculation of r_a for vertical surfaces
1709	!--
1710	!-- heat transfer coefficient for forced convection along vertical walls
1711	!-- follows formulation in TUF3d model (Krayenhoff & Voogt, 2006)
1712	!--
1713	!-- H = httc (Tsfc - Tair)
1714	!-- httc = rw * (11.8 + 4.2 * Ueff) - 4.0
1715	!--
1716	!-- rw: wall patch roughness relative to 1.0 for concrete
1717	!-- Ueff: effective wind speed
1718	!-- - 4.0 is a reduction of Rowley et al (1930) formulation based on
1719	!-- Cole and Sturrock (1977)
1720	!--
1721	!-- Ucan: Canyon wind speed
1722	!-- wstar: convective velocity
1723	!-- Qs: surface heat flux
1724	!-- zH: height of the convective layer
1725	!-- wstar = (g/TcanQszH)**(1./3.)
1726
1727	!-- Effective velocity components must always
1728	!-- be defined at scalar grid point. The wall normal component is
1729	!-- obtained by simple linear interpolation. ( An alternative would
1730	!-- be an logarithmic interpolation. )
1731	!-- A roughness lenght of 0.001 is assumed for concrete (the inverse,
1732	!-- 1000 is used in the nominator for scaling)
1733	!-- To do: detailed investigation which approach gives more reliable results!
1734	!-- Please note, in case of very small friction velocity, e.g. in little
1735	!-- holes, the resistance can become negative. For this reason, limit r_a
1736	!-- to positive values.
1737	IF ( horizontal .OR. .NOT. aero_resist_kray ) THEN
1738	surf%r_a(m) = ABS( ( surf%pt1(m) - surf%pt_surface(m) ) / &
1739	( surf%ts(m) * surf%us(m) + 1.0E-20_wp ) )
1740	ELSE
1741	surf%r_a(m) = rho_cp / ( surf%z0(m) * 1000.0_wp &
1742	* ( 11.8_wp + 4.2_wp * &
1743	SQRT( MAX( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 + &
1744	( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 + &
1745	( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2, &
1746	0.01_wp ) ) &
1747	) - 4.0_wp )
1748	ENDIF
1749	!
1750	!-- Make sure that the resistance does not drop to zero for neutral
1751	!-- stratification. Also, set a maximum resistance to avoid the breakdown of
1752	!-- MOST for locations with zero wind speed
1753	IF ( surf%r_a(m) < 1.0_wp ) surf%r_a(m) = 1.0_wp
1754	IF ( surf%r_a(m) > 300.0_wp ) surf%r_a(m) = 300.0_wp
1755	!
1756	!-- Second step: calculate canopy resistance r_canopy
1757	!-- f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
1758
1759	!-- f1: correction for incoming shortwave radiation (stomata close at
1760	!-- night)
1761	f1 = MIN( 1.0_wp, ( 0.004_wp * surf%rad_sw_in(m) + 0.05_wp ) / &
1762	(0.81_wp * (0.004_wp * surf%rad_sw_in(m) &
1763	+ 1.0_wp)) )
1764
1765	!
1766	!-- f2: correction for soil moisture availability to plants (the
1767	!-- integrated soil moisture must thus be considered here)
1768	!-- f2 = 0 for very dry soils
1769	m_total = 0.0_wp
1770	DO ks = nzb_soil, nzt_soil
1771	m_total = m_total + surf%root_fr(ks,m) &
1772	* MAX( surf_m_soil%var_2d(ks,m), surf%m_wilt(ks,m) )
1773	ENDDO
1774
1775	!
1776	!-- The calculation of f2 is based on only one wilting point value for all
1777	!-- soil layers. The value at k=nzb_soil is used here as a proxy but might
1778	!-- need refinement in the future.
1779	IF ( m_total > surf%m_wilt(nzb_soil,m) .AND. &
1780	m_total < surf%m_fc(nzb_soil,m) ) THEN
1781	f2 = ( m_total - surf%m_wilt(nzb_soil,m) ) / &
1782	( surf%m_fc(nzb_soil,m) - surf%m_wilt(nzb_soil,m) )
1783	ELSEIF ( m_total >= surf%m_fc(nzb_soil,m) ) THEN
1784	f2 = 1.0_wp
1785	ELSE
1786	f2 = 1.0E-20_wp
1787	ENDIF
1788
1789	!
1790	!-- Calculate water vapour pressure at saturation and convert to hPa
1791	!-- The magnus formula is limited to temperatures up to 333.15 K to
1792	!-- avoid negative values of q_s
1793	e_s = 0.01_wp * magnus( MIN(surf_t_surface%var_1d(m), 333.15_wp) )
1794
1795	!
1796	!-- f3: correction for vapour pressure deficit
1797	IF ( surf%g_d(m) /= 0.0_wp ) THEN
1798	!
1799	!-- Calculate vapour pressure
1800	e = surf%qv1(m) * surface_pressure / ( surf%qv1(m) + rd_d_rv )
1801	f3 = EXP ( - surf%g_d(m) * (e_s - e) )
1802	ELSE
1803	f3 = 1.0_wp
1804	ENDIF
1805	!
1806	!-- Calculate canopy resistance. In case that c_veg is 0 (bare soils),
1807	!-- this calculation is obsolete, as r_canopy is not used below.
1808	!-- To do: check for very dry soil -> r_canopy goes to infinity
1809	surf%r_canopy(m) = surf%r_canopy_min(m) / &
1810	( surf%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
1811	!
1812	!-- Third step: calculate bare soil resistance r_soil.
1813	m_min = surf%c_veg(m) * surf%m_wilt(nzb_soil,m) + &
1814	( 1.0_wp - surf%c_veg(m) ) * surf%m_res(nzb_soil,m)
1815
1816
1817	f2 = ( surf_m_soil%var_2d(nzb_soil,m) - m_min ) / &
1818	( surf%m_fc(nzb_soil,m) - m_min )
1819	f2 = MAX( f2, 1.0E-20_wp )
1820	f2 = MIN( f2, 1.0_wp )
1821
1822	surf%r_soil(m) = surf%r_soil_min(m) / f2
1823
1824	!
1825	!-- Calculate the maximum possible liquid water amount on plants and
1826	!-- bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is
1827	!-- assumed, while paved surfaces might hold up 1 mm of water. The
1828	!-- liquid water fraction for paved surfaces is calculated after
1829	!-- Masson (2000) (TEB model) and originates from Noilhan & Planton (1989),
1830	!-- while the ECMWF formulation is used for vegetated surfaces and bare soils.
1831	IF ( surf%pavement_surface(m) ) THEN
1832	m_liq_max = m_max_depth * 5.0_wp
1833	surf%c_liq(m) = MIN( 1.0_wp, ( surf_m_liq%var_1d(m) / m_liq_max)**0.67 )
1834	ELSE
1835	m_liq_max = m_max_depth * ( surf%c_veg(m) * surf%lai(m) &
1836	+ ( 1.0_wp - surf%c_veg(m) ) )
1837	surf%c_liq(m) = MIN( 1.0_wp, surf_m_liq%var_1d(m) / m_liq_max )
1838	ENDIF
1839	!
1840	!-- Calculate saturation water vapor mixing ratio
1841	q_s = rd_d_rv * e_s / ( surface_pressure - e_s )
1842	!
1843	!-- In case of dewfall, set evapotranspiration to zero
1844	!-- All super-saturated water is then removed from the air
1845	IF ( humidity .AND. q_s <= surf%qv1(m) ) THEN
1846	surf%r_canopy(m) = 0.0_wp
1847	surf%r_soil(m) = 0.0_wp
1848	ENDIF
1849
1850	!
1851	!-- Calculate coefficients for the total evapotranspiration
1852	!-- In case of water surface, set vegetation and soil fluxes to zero.
1853	!-- For pavements, only evaporation of liquid water is possible.
1854	IF ( surf%water_surface(m) ) THEN
1855	f_qsws_veg = 0.0_wp
1856	f_qsws_soil = 0.0_wp
1857	f_qsws_liq = rho_lv / surf%r_a(m)
1858	ELSEIF ( surf%pavement_surface(m) ) THEN
1859	f_qsws_veg = 0.0_wp
1860	f_qsws_soil = 0.0_wp
1861	f_qsws_liq = rho_lv * surf%c_liq(m) / surf%r_a(m)
1862	ELSE
1863	f_qsws_veg = rho_lv * surf%c_veg(m) * &
1864	( 1.0_wp - surf%c_liq(m) ) / &
1865	( surf%r_a(m) + surf%r_canopy(m) )
1866	f_qsws_soil = rho_lv * (1.0_wp - surf%c_veg(m) ) &
1867	* (1.0_wp - surf%c_liq(m) ) / &
1868	( surf%r_a(m) + surf%r_soil(m) )
1869	f_qsws_liq = rho_lv * surf%c_liq(m) / surf%r_a(m)
1870	ENDIF
1871
1872	f_shf = rho_cp / surf%r_a(m)
1873	f_qsws = f_qsws_veg + f_qsws_soil + f_qsws_liq
1874	!
1875	!-- Calculate derivative of q_s for Taylor series expansion
1876	e_s_dt = e_s * ( 17.62_wp / ( surf_t_surface%var_1d(m) - 29.65_wp) - &
1877	17.62_wp*( surf_t_surface%var_1d(m) - 273.15_wp) &
1878	/ ( surf_t_surface%var_1d(m) - 29.65_wp)**2 )
1879
1880	dq_s_dt = rd_d_rv * e_s_dt / ( surface_pressure - e_s_dt )
1881	!
1882	!-- Calculate net radiation radiation without longwave outgoing flux because
1883	!-- it has a dependency on surface temperature and thus enters the prognostic
1884	!-- equations directly
1885	surf%rad_net_l(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) &
1886	+ surf%rad_lw_in(m)
1887	!
1888	!-- Calculate new skin temperature
1889	IF ( humidity ) THEN
1890	!
1891	!-- Numerator of the prognostic equation
1892	coef_1 = surf%rad_net_l(m) + surf%rad_lw_out_change_0(m) &
1893	* surf_t_surface%var_1d(m) - surf%rad_lw_out(m) &
1894	+ f_shf * surf%pt1(m) + f_qsws * ( surf%qv1(m) - q_s &
1895	+ dq_s_dt * surf_t_surface%var_1d(m) ) + lambda_surface &
1896	* surf_t_soil%var_2d(nzb_soil,m)
1897
1898	!
1899	!-- Denominator of the prognostic equation
1900	coef_2 = surf%rad_lw_out_change_0(m) + f_qsws * dq_s_dt &
1901	+ lambda_surface + f_shf / exner(nzb)
1902	ELSE
1903	!
1904	!-- Numerator of the prognostic equation
1905	coef_1 = surf%rad_net_l(m) + surf%rad_lw_out_change_0(m) &
1906	* surf_t_surface%var_1d(m) - surf%rad_lw_out(m) &
1907	+ f_shf * surf%pt1(m) + lambda_surface &
1908	* surf_t_soil%var_2d(nzb_soil,m)
1909	!
1910	!-- Denominator of the prognostic equation
1911	coef_2 = surf%rad_lw_out_change_0(m) + lambda_surface + f_shf / exner(nzb)
1912
1913	ENDIF
1914
1915	tend = 0.0_wp
1916
1917	!
1918	!-- Implicit solution when the surface layer has no heat capacity,
1919	!-- otherwise use RK3 scheme.
1920	surf_t_surface_p%var_1d(m) = ( coef_1 * dt_3d * tsc(2) + c_surface_tmp *&
1921	surf_t_surface%var_1d(m) ) / ( c_surface_tmp + coef_2&
1922	* dt_3d * tsc(2) )
1923
1924	!
1925	!-- Add RK3 term
1926	IF ( c_surface_tmp /= 0.0_wp ) THEN
1927
1928	surf_t_surface_p%var_1d(m) = surf_t_surface_p%var_1d(m) + dt_3d * &
1929	tsc(3) * surf_tt_surface_m%var_1d(m)
1930
1931	!
1932	!-- Calculate true tendency
1933	tend = ( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) - &
1934	dt_3d * tsc(3) * surf_tt_surface_m%var_1d(m)) / (dt_3d * tsc(2))
1935	!
1936	!-- Calculate t_surface tendencies for the next Runge-Kutta step
1937	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1938	IF ( intermediate_timestep_count == 1 ) THEN
1939	surf_tt_surface_m%var_1d(m) = tend
1940	ELSEIF ( intermediate_timestep_count < &
1941	intermediate_timestep_count_max ) THEN
1942	surf_tt_surface_m%var_1d(m) = -9.5625_wp * tend + &
1943	5.3125_wp * surf_tt_surface_m%var_1d(m)
1944	ENDIF
1945	ENDIF
1946	ENDIF
1947
1948	!
1949	!-- In case of fast changes in the skin temperature, it is possible to
1950	!-- update the radiative fluxes independently from the prescribed
1951	!-- radiation call frequency. This effectively prevents oscillations,
1952	!-- especially when setting skip_time_do_radiation /= 0. The threshold
1953	!-- value of 0.2 used here is just a first guess. This method should be
1954	!-- revised in the future as tests have shown that the threshold is
1955	!-- often reached, when no oscillations would occur (causes immense
1956	!-- computing time for the radiation code).
1957	IF ( ABS( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) ) &
1958	> 0.2_wp .AND. &
1959	unscheduled_radiation_calls ) THEN
1960	force_radiation_call_l = .TRUE.
1961	ENDIF
1962
1963	surf%pt_surface(m) = surf_t_surface_p%var_1d(m) / exner(nzb)
1964
1965	!
1966	!-- Calculate fluxes
1967	surf%rad_net_l(m) = surf%rad_net_l(m) + &
1968	surf%rad_lw_out_change_0(m) &
1969	* surf_t_surface%var_1d(m) - surf%rad_lw_out(m) &
1970	- surf%rad_lw_out_change_0(m) * surf_t_surface_p%var_1d(m)
1971
1972	surf%rad_net(m) = surf%rad_net_l(m)
1973	surf%rad_lw_out(m) = surf%rad_lw_out(m) + surf%rad_lw_out_change_0(m) * &
1974	( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) )
1975
1976	surf%ghf(m) = lambda_surface * ( surf_t_surface_p%var_1d(m) &
1977	- surf_t_soil%var_2d(nzb_soil,m) )
1978
1979	surf%shf(m) = - f_shf * ( surf%pt1(m) - surf%pt_surface(m) ) / c_p
1980
1981	!
1982	! update the 3d field of rad_lw_out array to have consistent output
1983	IF ( horizontal ) THEN
1984	IF ( radiation_scheme == 'rrtmg' ) THEN
1985	rad_lw_out(k+k_off,j+j_off,i+i_off) = surf%rad_lw_out(m)
1986	ELSE
1987	rad_lw_out(0,j+j_off,i+i_off) = surf%rad_lw_out(m)
1988	ENDIF
1989	ENDIF
1990
1991	IF ( humidity ) THEN
1992	surf%qsws(m) = - f_qsws * ( surf%qv1(m) - q_s + dq_s_dt &
1993	* surf_t_surface%var_1d(m) - dq_s_dt * &
1994	surf_t_surface_p%var_1d(m) )
1995
1996	surf%qsws_veg(m) = - f_qsws_veg * ( surf%qv1(m) - q_s &
1997	+ dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt &
1998	* surf_t_surface_p%var_1d(m) )
1999
2000	surf%qsws_soil(m) = - f_qsws_soil * ( surf%qv1(m) - q_s &
2001	+ dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt &
2002	* surf_t_surface_p%var_1d(m) )
2003
2004	surf%qsws_liq(m) = - f_qsws_liq * ( surf%qv1(m) - q_s &
2005	+ dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt &
2006	* surf_t_surface_p%var_1d(m) )
2007	ENDIF
2008
2009	!
2010	!-- Calculate the true surface resistance. ABS is used here to avoid negative
2011	!-- values that can occur for very small fluxes due to the artifical addition
2012	!-- of 1.0E-20.
2013	IF ( .NOT. humidity ) THEN
2014	surf%r_s(m) = 1.0E10_wp
2015	ELSE
2016	surf%r_s(m) = ABS(rho_lv / (f_qsws + 1.0E-20_wp) - surf%r_a(m))
2017	ENDIF
2018	!
2019	!-- Calculate change in liquid water reservoir due to dew fall or
2020	!-- evaporation of liquid water
2021	IF ( humidity ) THEN
2022	!
2023	!-- If precipitation is activated, add rain water to qsws_liq
2024	!-- and qsws_soil according the the vegetation coverage.
2025	!-- precipitation_rate is given in mm.
2026	IF ( precipitation ) THEN
2027
2028	!
2029	!-- Add precipitation to liquid water reservoir, if possible.
2030	!-- Otherwise, add the water to soil. In case of
2031	!-- pavements, the exceeding water amount is explicitly removed
2032	!-- (as fictive runoff by drainage systems)
2033	IF ( surf%pavement_surface(m) ) THEN
2034	IF ( surf_m_liq%var_1d(m) < m_liq_max ) THEN
2035	surf%qsws_liq(m) = surf%qsws_liq(m) &
2036	+ prr(k+k_off,j+j_off,i+i_off) &
2037	* hyrho(k+k_off) &
2038	* 0.001_wp * rho_l * l_v
2039	ENDIF
2040	ELSE
2041	IF ( surf_m_liq%var_1d(m) < m_liq_max ) THEN
2042	surf%qsws_liq(m) = surf%qsws_liq(m) &
2043	+ surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)&
2044	* hyrho(k+k_off) &
2045	* 0.001_wp * rho_l * l_v
2046	surf%qsws_soil(m) = surf%qsws_soil(m) + ( 1.0_wp - &
2047	surf%c_veg(m) ) * prr(k+k_off,j+j_off,i+i_off)&
2048	* hyrho(k+k_off) &
2049	* 0.001_wp * rho_l * l_v
2050	ELSE
2051
2052	!-- Add precipitation to bare soil according to the bare soil
2053	!-- coverage.
2054	surf%qsws_soil(m) = surf%qsws_soil(m) &
2055	+ surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)&
2056	* hyrho(k+k_off) &
2057	* 0.001_wp * rho_l * l_v
2058
2059	ENDIF
2060	ENDIF
2061
2062	ENDIF
2063
2064	!
2065	!-- If the air is saturated, check the reservoir water level
2066	IF ( surf%qsws(m) < 0.0_wp ) THEN
2067	!
2068	!-- Check if reservoir is full (avoid values > m_liq_max)
2069	!-- In that case, qsws_liq goes to qsws_soil for pervious surfaces. In
2070	!-- this case qsws_veg is zero anyway (because c_liq = 1),
2071	!-- so that tend is zero and no further check is needed
2072	IF ( surf_m_liq%var_1d(m) == m_liq_max ) THEN
2073	IF ( .NOT. surf%pavement_surface(m)) THEN
2074	surf%qsws_soil(m) = surf%qsws_soil(m) + surf%qsws_liq(m)
2075	ENDIF
2076	surf%qsws_liq(m) = 0.0_wp
2077	ENDIF
2078
2079	!
2080	!-- In case qsws_veg becomes negative (unphysical behavior),
2081	!-- let the water enter the liquid water reservoir as dew on the
2082	!-- plant
2083	IF ( surf%qsws_veg(m) < 0.0_wp ) THEN
2084	surf%qsws_liq(m) = surf%qsws_liq(m) + surf%qsws_veg(m)
2085	surf%qsws_veg(m) = 0.0_wp
2086	ENDIF
2087	ENDIF
2088
2089	surf%qsws(m) = surf%qsws(m) / l_v
2090
2091	tend = - surf%qsws_liq(m) * drho_l_lv
2092	surf_m_liq_p%var_1d(m) = surf_m_liq%var_1d(m) + dt_3d * &
2093	( tsc(2) * tend + &
2094	tsc(3) * surf_tm_liq_m%var_1d(m) )
2095	!
2096	!-- Check if reservoir is overfull -> reduce to maximum
2097	!-- (conservation of water is violated here)
2098	surf_m_liq_p%var_1d(m) = MIN( surf_m_liq_p%var_1d(m),m_liq_max )
2099
2100	!
2101	!-- Check if reservoir is empty (avoid values < 0.0)
2102	!-- (conservation of water is violated here)
2103	surf_m_liq_p%var_1d(m) = MAX( surf_m_liq_p%var_1d(m), 0.0_wp )
2104	!
2105	!-- Calculate m_liq tendencies for the next Runge-Kutta step
2106	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2107	IF ( intermediate_timestep_count == 1 ) THEN
2108	surf_tm_liq_m%var_1d(m) = tend
2109	ELSEIF ( intermediate_timestep_count < &
2110	intermediate_timestep_count_max ) THEN
2111	surf_tm_liq_m%var_1d(m) = -9.5625_wp * tend + &
2112	5.3125_wp * surf_tm_liq_m%var_1d(m)
2113	ENDIF
2114	ENDIF
2115
2116	ENDIF
2117
2118	ENDDO
2119	!$OMP END PARALLEL
2120
2121	!
2122	!-- Make a logical OR for all processes. Force radiation call if at
2123	!-- least one processor reached the threshold change in skin temperature
2124	IF ( unscheduled_radiation_calls .AND. intermediate_timestep_count &
2125	== intermediate_timestep_count_max-1 ) THEN
2126	#if defined( __parallel )
2127	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
2128	CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call, &
2129	1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
2130	#else
2131	force_radiation_call = force_radiation_call_l
2132	#endif
2133	force_radiation_call_l = .FALSE.
2134	ENDIF
2135
2136	!
2137	!-- Calculate surface water vapor mixing ratio
2138	IF ( humidity ) THEN
2139	CALL calc_q_surface
2140	ENDIF
2141
2142	!
2143	!-- Calculate new roughness lengths (for water surfaces only)
2144	IF ( horizontal .AND. .NOT. constant_roughness ) CALL calc_z0_water_surface
2145
2146	IF ( debug_output_timestep ) THEN
2147	WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l
2148	CALL debug_message( debug_string, 'end' )
2149	ENDIF
2150
2151	CONTAINS
2152	!------------------------------------------------------------------------------!
2153	! Description:
2154	! ------------
2155	!> Calculation of mixing ratio of the skin layer (surface). It is assumend
2156	!> that the skin is always saturated.
2157	!------------------------------------------------------------------------------!
2158	SUBROUTINE calc_q_surface
2159
2160	IMPLICIT NONE
2161
2162	REAL(wp) :: e_s !< saturation water vapor pressure
2163	REAL(wp) :: q_s !< saturation mixing ratio
2164	REAL(wp) :: resistance !< aerodynamic and soil resistance term
2165
2166
2167	!$OMP PARALLEL PRIVATE (m, i, j, k, e_s, q_s, resistance)
2168	!$OMP DO SCHEDULE (STATIC)
2169	DO m = 1, surf%ns
2170
2171	i = surf%i(m)
2172	j = surf%j(m)
2173	k = surf%k(m)
2174	!
2175	!-- Calculate water vapour pressure at saturation and convert to hPa
2176	e_s = 0.01_wp * magnus( MIN(surf_t_surface_p%var_1d(m), 333.15_wp) )
2177
2178	!
2179	!-- Calculate mixing ratio at saturation
2180	q_s = rd_d_rv * e_s / ( surface_pressure - e_s )
2181
2182	resistance = surf%r_a(m) / ( surf%r_a(m) + surf%r_s(m) + 1E-5_wp )
2183
2184	!
2185	!-- Calculate mixing ratio at surface
2186	IF ( bulk_cloud_model ) THEN
2187	q(k+k_off,j+j_off,i+i_off) = resistance * q_s + &
2188	( 1.0_wp - resistance ) * &
2189	( q(k,j,i) - ql(k,j,i) )
2190	ELSE
2191	q(k+k_off,j+j_off,i+i_off) = resistance * q_s + &
2192	( 1.0_wp - resistance ) * &
2193	q(k,j,i)
2194	ENDIF
2195
2196	surf%q_surface(m) = q(k+k_off,j+j_off,i+i_off)
2197	!
2198	!-- Update virtual potential temperature
2199	surf%vpt_surface(m) = surf%pt_surface(m) * &
2200	( 1.0_wp + 0.61_wp * surf%q_surface(m) )
2201
2202
2203
2204	ENDDO
2205	!$OMP END PARALLEL
2206
2207	END SUBROUTINE calc_q_surface
2208
2209	END SUBROUTINE lsm_energy_balance
2210
2211
2212
2213	!------------------------------------------------------------------------------!
2214	! Description:
2215	! ------------
2216	!> Header output for land surface model
2217	!------------------------------------------------------------------------------!
2218	SUBROUTINE lsm_header ( io )
2219
2220
2221	IMPLICIT NONE
2222
2223	CHARACTER (LEN=86) :: t_soil_chr !< String for soil temperature profile
2224	CHARACTER (LEN=86) :: roots_chr !< String for root profile
2225	CHARACTER (LEN=86) :: vertical_index_chr !< String for the vertical index
2226	CHARACTER (LEN=86) :: m_soil_chr !< String for soil moisture
2227	CHARACTER (LEN=86) :: soil_depth_chr !< String for soil depth
2228	CHARACTER (LEN=10) :: coor_chr !< Temporary string
2229
2230	INTEGER(iwp) :: i !< Loop index over soil layers
2231
2232	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
2233
2234	t_soil_chr = ''
2235	m_soil_chr = ''
2236	soil_depth_chr = ''
2237	roots_chr = ''
2238	vertical_index_chr = ''
2239
2240	i = 1
2241	DO i = nzb_soil, nzt_soil
2242	WRITE (coor_chr,'(F10.2,7X)') soil_temperature(i)
2243	t_soil_chr = TRIM( t_soil_chr ) // ' ' // TRIM( coor_chr )
2244
2245	WRITE (coor_chr,'(F10.2,7X)') soil_moisture(i)
2246	m_soil_chr = TRIM( m_soil_chr ) // ' ' // TRIM( coor_chr )
2247
2248	WRITE (coor_chr,'(F10.2,7X)') - zs(i)
2249	soil_depth_chr = TRIM( soil_depth_chr ) // ' ' // TRIM( coor_chr )
2250
2251	WRITE (coor_chr,'(F10.2,7X)') root_fraction(i)
2252	roots_chr = TRIM( roots_chr ) // ' ' // TRIM( coor_chr )
2253
2254	WRITE (coor_chr,'(I10,7X)') i
2255	vertical_index_chr = TRIM( vertical_index_chr ) // ' ' // &
2256	TRIM( coor_chr )
2257	ENDDO
2258
2259	!
2260	!-- Write land surface model header
2261	WRITE( io, 1 )
2262	IF ( conserve_water_content ) THEN
2263	WRITE( io, 2 )
2264	ELSE
2265	WRITE( io, 3 )
2266	ENDIF
2267
2268	IF ( vegetation_type_f%from_file ) THEN
2269	WRITE( io, 5 )
2270	ELSE
2271	WRITE( io, 4 ) TRIM( vegetation_type_name(vegetation_type) ), &
2272	TRIM (soil_type_name(soil_type) )
2273	ENDIF
2274	WRITE( io, 6 ) TRIM( soil_depth_chr ), TRIM( t_soil_chr ), &
2275	TRIM( m_soil_chr ), TRIM( roots_chr ), &
2276	TRIM( vertical_index_chr )
2277
2278	1 FORMAT (//' Land surface model information:'/ &
2279	' ------------------------------'/)
2280	2 FORMAT (' --> Soil bottom is closed (water content is conserved', &
2281	', default)')
2282	3 FORMAT (' --> Soil bottom is open (water content is not conserved)')
2283	4 FORMAT (' --> Land surface type : ',A,/ &
2284	' --> Soil porosity type : ',A)
2285	5 FORMAT (' --> Land surface type : read from file' / &
2286	' --> Soil porosity type : read from file' )
2287	6 FORMAT (/' Initial soil temperature and moisture profile:'// &
2288	' Height: ',A,' m'/ &
2289	' Temperature: ',A,' K'/ &
2290	' Moisture: ',A,' m3/m3'/ &
2291	' Root fraction: ',A,' '/ &
2292	' Grid point: ',A)
2293
2294
2295	END SUBROUTINE lsm_header
2296
2297
2298	!------------------------------------------------------------------------------!
2299	! Description:
2300	! ------------
2301	!> Initialization of the land surface model
2302	!------------------------------------------------------------------------------!
2303	SUBROUTINE lsm_init
2304
2305	USE control_parameters, &
2306	ONLY: message_string
2307
2308	USE indices, &
2309	ONLY: nx, ny, topo_min_level
2310
2311	USE pmc_handle_communicator, &
2312	ONLY: pmc_is_rootmodel
2313
2314	USE pmc_interface, &
2315	ONLY: nested_run
2316
2317	IMPLICIT NONE
2318
2319	INTEGER(iwp) :: i !< running index
2320	INTEGER(iwp) :: j !< running index
2321	INTEGER(iwp) :: k !< running index
2322	INTEGER(iwp) :: kn !< running index
2323	INTEGER(iwp) :: ko !< running index
2324	INTEGER(iwp) :: kroot !< running index
2325	INTEGER(iwp) :: kzs !< running index
2326	INTEGER(iwp) :: l !< running index surface facing
2327	INTEGER(iwp) :: m !< running index
2328	INTEGER(iwp) :: st !< soil-type index
2329	INTEGER(iwp) :: n_soil_layers_total !< temperature variable, stores the total number of soil layers + 4
2330	#if defined( __parallel )
2331	INTEGER(iwp) :: nzs_root !< number of soil layers in root domain (used in case soil data needs to be
2332	!< transferred from root model to child models)
2333
2334	REAL(wp), DIMENSION(:), ALLOCATABLE :: m_soil_root !< domain-averaged soil moisture profile in root domain
2335	REAL(wp), DIMENSION(:), ALLOCATABLE :: t_soil_root !< domain-averaged soil temperature profile in root domain
2336	#endif
2337	REAL(wp), DIMENSION(:), ALLOCATABLE :: bound !< temporary arrays for storing index bounds
2338	REAL(wp), DIMENSION(:), ALLOCATABLE :: bound_root_fr !< temporary arrays for storing index bounds
2339	REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_soil_init !< temporary array used for averaging soil profiles
2340	#if defined( __parallel )
2341	REAL(wp), DIMENSION(:), ALLOCATABLE :: z_soil_root !< vertical dimension of soil grid in root domain
2342	#endif
2343
2344	IF ( debug_output ) CALL debug_message( 'lsm_init', 'start' )
2345	!
2346	!-- If no cloud physics is used, rho_surface has not been calculated before
2347	IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
2348	CALL calc_mean_profile( pt, 4 )
2349	rho_surface = hyp(nzb) / ( r_d * hom(topo_min_level+1,1,4,0) * exner(nzb) )
2350	ENDIF
2351
2352	!
2353	!-- Calculate frequently used parameters
2354	rho_cp = c_p * rho_surface
2355	rho_lv = rho_surface * l_v
2356	drho_l_lv = 1.0_wp / (rho_l * l_v)
2357
2358	!
2359	!-- Set initial values for prognostic quantities
2360	!-- Horizontal surfaces
2361	tt_surface_h_m%var_1d = 0.0_wp
2362	tt_soil_h_m%var_2d = 0.0_wp
2363	tm_soil_h_m%var_2d = 0.0_wp
2364	tm_liq_h_m%var_1d = 0.0_wp
2365	surf_lsm_h%c_liq = 0.0_wp
2366
2367	surf_lsm_h%ghf = 0.0_wp
2368
2369	surf_lsm_h%qsws_liq = 0.0_wp
2370	surf_lsm_h%qsws_soil = 0.0_wp
2371	surf_lsm_h%qsws_veg = 0.0_wp
2372
2373	surf_lsm_h%r_a = 50.0_wp
2374	surf_lsm_h%r_s = 50.0_wp
2375	surf_lsm_h%r_canopy = 0.0_wp
2376	surf_lsm_h%r_soil = 0.0_wp
2377	!
2378	!-- Do the same for vertical surfaces
2379	DO l = 0, 3
2380	tt_surface_v_m(l)%var_1d = 0.0_wp
2381	tt_soil_v_m(l)%var_2d = 0.0_wp
2382	tm_soil_v_m(l)%var_2d = 0.0_wp
2383	tm_liq_v_m(l)%var_1d = 0.0_wp
2384	surf_lsm_v(l)%c_liq = 0.0_wp
2385
2386	surf_lsm_v(l)%ghf = 0.0_wp
2387
2388	surf_lsm_v(l)%qsws_liq = 0.0_wp
2389	surf_lsm_v(l)%qsws_soil = 0.0_wp
2390	surf_lsm_v(l)%qsws_veg = 0.0_wp
2391
2392	surf_lsm_v(l)%r_a = 50.0_wp
2393	surf_lsm_v(l)%r_s = 50.0_wp
2394	surf_lsm_v(l)%r_canopy = 0.0_wp
2395	surf_lsm_v(l)%r_soil = 0.0_wp
2396	ENDDO
2397
2398	!
2399	!-- Set initial values for prognostic soil quantities
2400	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
2401	t_soil_h%var_2d = 0.0_wp
2402	m_soil_h%var_2d = 0.0_wp
2403	m_liq_h%var_1d = 0.0_wp
2404
2405	DO l = 0, 3
2406	t_soil_v(l)%var_2d = 0.0_wp
2407	m_soil_v(l)%var_2d = 0.0_wp
2408	m_liq_v(l)%var_1d = 0.0_wp
2409	ENDDO
2410	ENDIF
2411	!
2412	!-- Allocate 3D soil model arrays
2413	!-- First, for horizontal surfaces
2414	ALLOCATE ( surf_lsm_h%alpha_vg(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2415	ALLOCATE ( surf_lsm_h%gamma_w_sat(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2416	ALLOCATE ( surf_lsm_h%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2417	ALLOCATE ( surf_lsm_h%lambda_h_def(nzb_soil:nzt_soil,1:surf_lsm_h%ns))
2418	ALLOCATE ( surf_lsm_h%l_vg(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2419	ALLOCATE ( surf_lsm_h%m_fc(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2420	ALLOCATE ( surf_lsm_h%m_res(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2421	ALLOCATE ( surf_lsm_h%m_sat(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2422	ALLOCATE ( surf_lsm_h%m_wilt(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2423	ALLOCATE ( surf_lsm_h%n_vg(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2424	ALLOCATE ( surf_lsm_h%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2425	ALLOCATE ( surf_lsm_h%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2426	ALLOCATE ( surf_lsm_h%root_fr(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2427
2428	surf_lsm_h%lambda_h = 0.0_wp
2429	!
2430	!-- If required, allocate humidity-related variables for the soil model
2431	IF ( humidity ) THEN
2432	ALLOCATE ( surf_lsm_h%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2433	ALLOCATE ( surf_lsm_h%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
2434
2435	surf_lsm_h%lambda_w = 0.0_wp
2436	ENDIF
2437	!
2438	!-- For vertical surfaces
2439	DO l = 0, 3
2440	ALLOCATE ( surf_lsm_v(l)%alpha_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2441	ALLOCATE ( surf_lsm_v(l)%gamma_w_sat(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2442	ALLOCATE ( surf_lsm_v(l)%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2443	ALLOCATE ( surf_lsm_v(l)%lambda_h_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns))
2444	ALLOCATE ( surf_lsm_v(l)%l_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2445	ALLOCATE ( surf_lsm_v(l)%m_fc(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2446	ALLOCATE ( surf_lsm_v(l)%m_res(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2447	ALLOCATE ( surf_lsm_v(l)%m_sat(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2448	ALLOCATE ( surf_lsm_v(l)%m_wilt(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2449	ALLOCATE ( surf_lsm_v(l)%n_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2450	ALLOCATE ( surf_lsm_v(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2451	ALLOCATE ( surf_lsm_v(l)%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2452	ALLOCATE ( surf_lsm_v(l)%root_fr(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2453
2454	surf_lsm_v(l)%lambda_h = 0.0_wp
2455
2456	!
2457	!-- If required, allocate humidity-related variables for the soil model
2458	IF ( humidity ) THEN
2459	ALLOCATE ( surf_lsm_v(l)%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2460	ALLOCATE ( surf_lsm_v(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
2461
2462	surf_lsm_v(l)%lambda_w = 0.0_wp
2463	ENDIF
2464	ENDDO
2465	!
2466	!-- Allocate albedo type and emissivity for vegetation, water and pavement
2467	!-- fraction.
2468	!-- Set default values at each surface element.
2469	ALLOCATE ( surf_lsm_h%albedo_type(0:2,1:surf_lsm_h%ns) )
2470	ALLOCATE ( surf_lsm_h%emissivity(0:2,1:surf_lsm_h%ns) )
2471	!
2472	!-- Initialize albedo type according to its default type, in order to set values
2473	!-- independent on default albedo_type in radiation model.
2474	surf_lsm_h%albedo_type(ind_veg_wall,:) = &
2475	INT( vegetation_pars(ind_v_at,vegetation_type) )
2476	surf_lsm_h%albedo_type(ind_wat_win,:) = &
2477	INT( water_pars(ind_w_at,water_type) )
2478	surf_lsm_h%albedo_type(ind_pav_green,:) = &
2479	INT( pavement_pars(ind_p_at,pavement_type) )
2480	surf_lsm_h%emissivity = emissivity
2481	DO l = 0, 3
2482	ALLOCATE ( surf_lsm_v(l)%albedo_type(0:2,1:surf_lsm_v(l)%ns) )
2483	ALLOCATE ( surf_lsm_v(l)%emissivity(0:2,1:surf_lsm_v(l)%ns) )
2484	!
2485	!-- Initialize albedo type according to its default type, in order to
2486	!-- set values independent on default albedo_type in radiation model.
2487	surf_lsm_v(l)%albedo_type(ind_veg_wall,:) = &
2488	INT( vegetation_pars(ind_v_at,vegetation_type) )
2489	surf_lsm_v(l)%albedo_type(ind_wat_win,:) = &
2490	INT( water_pars(ind_w_at,water_type) )
2491	surf_lsm_v(l)%albedo_type(ind_pav_green,:) = &
2492	INT( pavement_pars(ind_p_at,pavement_type) )
2493	surf_lsm_v(l)%emissivity = emissivity
2494	ENDDO
2495	!
2496	!-- Allocate arrays for relative surface fraction.
2497	!-- 0 - vegetation fraction, 2 - water fraction, 1 - pavement fraction
2498	ALLOCATE( surf_lsm_h%frac(0:2,1:surf_lsm_h%ns) )
2499	surf_lsm_h%frac = 0.0_wp
2500	DO l = 0, 3
2501	ALLOCATE( surf_lsm_v(l)%frac(0:2,1:surf_lsm_v(l)%ns) )
2502	surf_lsm_v(l)%frac = 0.0_wp
2503	ENDDO
2504	!
2505	!-- For vertical walls only - allocate special flag indicating if any building is on
2506	!-- top of any natural surfaces. Used for initialization only.
2507	DO l = 0, 3
2508	ALLOCATE( surf_lsm_v(l)%building_covered(1:surf_lsm_v(l)%ns) )
2509	ENDDO
2510	!
2511	!-- Allocate arrays for the respective types and their names on the surface
2512	!-- elements. This will be required to treat deposition of chemical species.
2513	ALLOCATE( surf_lsm_h%pavement_type(1:surf_lsm_h%ns) )
2514	ALLOCATE( surf_lsm_h%vegetation_type(1:surf_lsm_h%ns) )
2515	ALLOCATE( surf_lsm_h%water_type(1:surf_lsm_h%ns) )
2516
2517	surf_lsm_h%pavement_type = 0
2518	surf_lsm_h%vegetation_type = 0
2519	surf_lsm_h%water_type = 0
2520
2521	ALLOCATE( surf_lsm_h%pavement_type_name(1:surf_lsm_h%ns) )
2522	ALLOCATE( surf_lsm_h%vegetation_type_name(1:surf_lsm_h%ns) )
2523	ALLOCATE( surf_lsm_h%water_type_name(1:surf_lsm_h%ns) )
2524
2525	surf_lsm_h%pavement_type_name = 'none'
2526	surf_lsm_h%vegetation_type_name = 'none'
2527	surf_lsm_h%water_type_name = 'none'
2528
2529	DO l = 0, 3
2530	ALLOCATE( surf_lsm_v(l)%pavement_type(1:surf_lsm_v(l)%ns) )
2531	ALLOCATE( surf_lsm_v(l)%vegetation_type(1:surf_lsm_v(l)%ns) )
2532	ALLOCATE( surf_lsm_v(l)%water_type(1:surf_lsm_v(l)%ns) )
2533
2534	surf_lsm_v(l)%pavement_type = 0
2535	surf_lsm_v(l)%vegetation_type = 0
2536	surf_lsm_v(l)%water_type = 0
2537
2538	ALLOCATE( surf_lsm_v(l)%pavement_type_name(1:surf_lsm_v(l)%ns) )
2539	ALLOCATE( surf_lsm_v(l)%vegetation_type_name(1:surf_lsm_v(l)%ns) )
2540	ALLOCATE( surf_lsm_v(l)%water_type_name(1:surf_lsm_v(l)%ns) )
2541
2542	surf_lsm_v(l)%pavement_type_name = 'none'
2543	surf_lsm_v(l)%vegetation_type_name = 'none'
2544	surf_lsm_v(l)%water_type_name = 'none'
2545	ENDDO
2546
2547	!
2548	!-- Set flag parameter for the prescribed surface type depending on user
2549	!-- input. Set surface fraction to 1 for the respective type.
2550	SELECT CASE ( TRIM( surface_type ) )
2551
2552	CASE ( 'vegetation' )
2553
2554	surf_lsm_h%vegetation_surface = .TRUE.
2555	surf_lsm_h%frac(ind_veg_wall,:) = 1.0_wp
2556	DO l = 0, 3
2557	surf_lsm_v(l)%vegetation_surface = .TRUE.
2558	surf_lsm_v(l)%frac(ind_veg_wall,:) = 1.0_wp
2559	ENDDO
2560
2561	CASE ( 'water' )
2562
2563	surf_lsm_h%water_surface = .TRUE.
2564	surf_lsm_h%frac(ind_wat_win,:) = 1.0_wp
2565	!
2566	!-- Note, vertical water surface does not really make sense.
2567	DO l = 0, 3
2568	surf_lsm_v(l)%water_surface = .TRUE.
2569	surf_lsm_v(l)%frac(ind_wat_win,:) = 1.0_wp
2570	ENDDO
2571
2572	CASE ( 'pavement' )
2573
2574	surf_lsm_h%pavement_surface = .TRUE.
2575	surf_lsm_h%frac(ind_pav_green,:) = 1.0_wp
2576	DO l = 0, 3
2577	surf_lsm_v(l)%pavement_surface = .TRUE.
2578	surf_lsm_v(l)%frac(ind_pav_green,:) = 1.0_wp
2579	ENDDO
2580
2581	CASE ( 'netcdf' )
2582
2583	DO m = 1, surf_lsm_h%ns
2584	i = surf_lsm_h%i(m)
2585	j = surf_lsm_h%j(m)
2586	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) &
2587	surf_lsm_h%vegetation_surface(m) = .TRUE.
2588	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) &
2589	surf_lsm_h%pavement_surface(m) = .TRUE.
2590	IF ( water_type_f%var(j,i) /= water_type_f%fill ) &
2591	surf_lsm_h%water_surface(m) = .TRUE.
2592	!
2593	!-- Check if at least one type is set.
2594	IF ( .NOT. surf_lsm_h%vegetation_surface(m) .AND. &
2595	.NOT. surf_lsm_h%pavement_surface(m) .AND. &
2596	.NOT. surf_lsm_h%water_surface(m) ) THEN
2597	WRITE( message_string, * ) 'Horizontal surface element ' // &
2598	' at i, j = ', i, j, &
2599	' is neither a vegetation, ' // &
2600	'pavement, nor a water surface.'
2601	CALL message( 'land_surface_model_mod', 'PA0619', &
2602	2, 2, myid, 6, 0 )
2603	ENDIF
2604
2605	ENDDO
2606	!
2607	!-- For vertical surfaces some special checks and treatment are
2608	!-- required for correct initialization.
2609	DO l = 0, 3
2610	DO m = 1, surf_lsm_v(l)%ns
2611	!
2612	!-- Only for vertical surfaces. Check if at the grid point where
2613	!-- the wall is defined (i+ioff, j+joff) is any building.
2614	!-- This case, no natural surfaces properties will be defined at
2615	!-- at this grid point, leading to problems in the initialization.
2616	!-- To overcome this, define a special flag which
2617	!-- indicates that a building is defined at the wall grid point
2618	!-- and take the surface properties from the adjoining grid
2619	!-- point, i.e. without offset values.
2620	!-- Further, there can occur a special case where elevation
2621	!-- changes are larger than building heights. This case, (j,i)
2622	!-- and (j+joff,i+ioff) grid points may be both covered by
2623	!-- buildings, but vertical, but vertically natural walls may
2624	!-- be located between the buildings. This case, it is not
2625	!-- guaranteed that information about natural surface types is
2626	!-- given, neither at (j,i) nor at (j+joff,i+ioff), again leading
2627	!-- to non-initialized surface properties.
2628	surf_lsm_v(l)%building_covered(m) = .FALSE.
2629	!
2630	!-- Wall grid point is building-covered. This case, set
2631	!-- flag indicating that surface properties are initialized
2632	!-- from neighboring reference grid point, which is not
2633	!-- building_covered.
2634	IF ( building_type_f%from_file ) THEN
2635	i = surf_lsm_v(l)%i(m)
2636	j = surf_lsm_v(l)%j(m)
2637	IF ( building_type_f%var(j+surf_lsm_v(l)%joff, &
2638	i+surf_lsm_v(l)%ioff) /= &
2639	building_type_f%fill ) &
2640	surf_lsm_v(l)%building_covered(m) = .TRUE.
2641	!
2642	!-- Wall grid point as well as neighboring reference grid
2643	!-- point are both building-covered. This case, surface
2644	!-- properties are not necessarily defined (not covered by
2645	!-- checks for static input file) at this surface. Hence,
2646	!-- initialize surface properties by simply setting
2647	!-- vegetation_type_f to bare-soil bulk parametrization.
2648	!-- soil_type_f as well as surface_fractions_f will be set
2649	!-- also.
2650	IF ( building_type_f%var(j+surf_lsm_v(l)%joff, &
2651	i+surf_lsm_v(l)%ioff) /= &
2652	building_type_f%fill .AND. &
2653	building_type_f%var(j,i) /= building_type_f%fill ) &
2654	THEN
2655	vegetation_type_f%var(j,i) = 1 ! bare soil
2656	soil_type_f%var_2d(j,i) = 1
2657	!
2658	!-- If surface_fraction is provided in static input,
2659	!-- set fraction for vegetation to one at building-covered
2660	!-- surfaces.
2661	IF ( surface_fraction_f%from_file ) THEN
2662	surface_fraction_f%frac(ind_veg_wall,j,i) = 1.0_wp
2663	surface_fraction_f%frac(ind_pav_green,j,i) = 0.0_wp
2664	surface_fraction_f%frac(ind_wat_win,j,i) = 0.0_wp
2665	ENDIF
2666	ENDIF
2667
2668	ENDIF
2669	!
2670	!-- Normally proceed with setting surface types.
2671	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
2672	surf_lsm_v(l)%building_covered(m) )
2673	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
2674	surf_lsm_v(l)%building_covered(m) )
2675	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) &
2676	surf_lsm_v(l)%vegetation_surface(m) = .TRUE.
2677	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) &
2678	surf_lsm_v(l)%pavement_surface(m) = .TRUE.
2679	IF ( water_type_f%var(j,i) /= water_type_f%fill ) &
2680	surf_lsm_v(l)%water_surface(m) = .TRUE.
2681	!
2682	!-- Check if at least one type is set.
2683	IF ( .NOT. surf_lsm_v(l)%vegetation_surface(m) .AND. &
2684	.NOT. surf_lsm_v(l)%pavement_surface(m) .AND. &
2685	.NOT. surf_lsm_v(l)%water_surface(m) ) THEN
2686	WRITE( message_string, * ) 'Vertical surface element ' //&
2687	' at i, j = ', i, j, &
2688	' is neither a vegetation, ' // &
2689	'pavement, nor a water surface.'
2690	CALL message( 'land_surface_model_mod', 'PA0619', &
2691	2, 2, myid, 6, 0 )
2692	ENDIF
2693	ENDDO
2694	ENDDO
2695
2696	END SELECT
2697	!
2698	!-- In case of netcdf input file, further initialize surface fractions.
2699	!-- At the moment only 1 surface is given at a location, so that the fraction
2700	!-- is either 0 or 1. This will be revised later. If surface fraction
2701	!-- is not given in static input file, relative fractions will be derived
2702	!-- from given surface type. In this case, only 1 type is given at a certain
2703	!-- location (already checked).
2704	IF ( input_pids_static .AND. surface_fraction_f%from_file ) THEN
2705	DO m = 1, surf_lsm_h%ns
2706	i = surf_lsm_h%i(m)
2707	j = surf_lsm_h%j(m)
2708	!
2709	!-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction
2710	IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= &
2711	surface_fraction_f%fill ) THEN
2712	surf_lsm_h%frac(ind_veg_wall,m) = &
2713	surface_fraction_f%frac(ind_veg_wall,j,i)
2714	ENDIF
2715	IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= &
2716	surface_fraction_f%fill ) THEN
2717	surf_lsm_h%frac(ind_pav_green,m) = &
2718	surface_fraction_f%frac(ind_pav_green,j,i)
2719	ENDIF
2720	IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= &
2721	surface_fraction_f%fill ) THEN
2722	surf_lsm_h%frac(ind_wat_win,m) = &
2723	surface_fraction_f%frac(ind_wat_win,j,i)
2724	ENDIF
2725	!
2726	!-- Check if sum of relative fractions is zero. This case, give an
2727	!-- error message.
2728	IF ( SUM ( surf_lsm_h%frac(:,m) ) == 0.0_wp ) THEN
2729	WRITE( message_string, * ) &
2730	'surface fractions at grid point (j,i) = (', &
2731	j, i, ') are all zero.'
2732	CALL message( 'land_surface_model_mod', 'PA0688', &
2733	2, 2, myid, 6, 0 )
2734	ENDIF
2735	!
2736	!-- In case the sum of all surfaces is not 1, which may happen
2737	!-- due to rounding errors or type conversions, normalize the
2738	!-- fractions to one. Note, at the moment no tile approach is
2739	!-- implemented, so that relative fractions are either 1 or zero.
2740	IF ( SUM ( surf_lsm_h%frac(:,m) ) > 1.0_wp .OR. &
2741	SUM ( surf_lsm_h%frac(:,m) ) < 1.0_wp ) THEN
2742	surf_lsm_h%frac(:,m) = surf_lsm_h%frac(:,m) / &
2743	SUM ( surf_lsm_h%frac(:,m) )
2744
2745	ENDIF
2746
2747	ENDDO
2748	DO l = 0, 3
2749	DO m = 1, surf_lsm_v(l)%ns
2750	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
2751	surf_lsm_v(l)%building_covered(m) )
2752	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
2753	surf_lsm_v(l)%building_covered(m) )
2754	!
2755	!-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction
2756	IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= &
2757	surface_fraction_f%fill ) THEN
2758	surf_lsm_v(l)%frac(ind_veg_wall,m) = &
2759	surface_fraction_f%frac(ind_veg_wall,j,i)
2760	ENDIF
2761	IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= &
2762	surface_fraction_f%fill ) THEN
2763	surf_lsm_v(l)%frac(ind_pav_green,m) = &
2764	surface_fraction_f%frac(ind_pav_green,j,i)
2765	ENDIF
2766	IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= &
2767	surface_fraction_f%fill ) THEN
2768	surf_lsm_v(l)%frac(ind_wat_win,m) = &
2769	surface_fraction_f%frac(ind_wat_win,j,i)
2770	ENDIF
2771	!
2772	!-- Check if sum of relative fractions is zero. This case, give an
2773	!-- error message.
2774	IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) == 0.0_wp ) THEN
2775	WRITE( message_string, * ) &
2776	'surface fractions at grid point (j,i) = (', &
2777	j, i, ') are all zero.'
2778	CALL message( 'land_surface_model_mod', 'PA0688', &
2779	2, 2, myid, 6, 0 )
2780	ENDIF
2781	!
2782	!-- In case the sum of all surfaces is not 1, which may happen
2783	!-- due to rounding errors or type conversions, normalize the
2784	!-- fractions to one. Note, at the moment no tile approach is
2785	!-- implemented, so that relative fractions are either 1 or zero.
2786	IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) > 1.0_wp .OR. &
2787	SUM ( surf_lsm_v(l)%frac(:,m) ) < 1.0_wp ) THEN
2788	surf_lsm_v(l)%frac(:,m) = surf_lsm_v(l)%frac(:,m) / &
2789	SUM ( surf_lsm_v(l)%frac(:,m) )
2790
2791	ENDIF
2792	ENDDO
2793	ENDDO
2794	ELSEIF ( input_pids_static .AND. .NOT. surface_fraction_f%from_file ) &
2795	THEN
2796	DO m = 1, surf_lsm_h%ns
2797	i = surf_lsm_h%i(m)
2798	j = surf_lsm_h%j(m)
2799
2800	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) &
2801	surf_lsm_h%frac(ind_veg_wall,m) = 1.0_wp
2802	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) &
2803	surf_lsm_h%frac(ind_pav_green,m) = 1.0_wp
2804	IF ( water_type_f%var(j,i) /= water_type_f%fill ) &
2805	surf_lsm_h%frac(ind_wat_win,m) = 1.0_wp
2806	ENDDO
2807	DO l = 0, 3
2808	DO m = 1, surf_lsm_v(l)%ns
2809	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
2810	surf_lsm_v(l)%building_covered(m) )
2811	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
2812	surf_lsm_v(l)%building_covered(m) )
2813
2814	IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) &
2815	surf_lsm_v(l)%frac(ind_veg_wall,m) = 1.0_wp
2816	IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) &
2817	surf_lsm_v(l)%frac(ind_pav_green,m) = 1.0_wp
2818	IF ( water_type_f%var(j,i) /= water_type_f%fill ) &
2819	surf_lsm_v(l)%frac(ind_wat_win,m) = 1.0_wp
2820	ENDDO
2821	ENDDO
2822	ENDIF
2823	!
2824	!-- Level 1, initialization of soil parameters.
2825	!-- It is possible to overwrite each parameter by setting the respecticy
2826	!-- NAMELIST variable to a value /= 9999999.9.
2827	IF ( soil_type /= 0 ) THEN
2828
2829	IF ( alpha_vangenuchten == 9999999.9_wp ) THEN
2830	alpha_vangenuchten = soil_pars(0,soil_type)
2831	ENDIF
2832
2833	IF ( l_vangenuchten == 9999999.9_wp ) THEN
2834	l_vangenuchten = soil_pars(1,soil_type)
2835	ENDIF
2836
2837	IF ( n_vangenuchten == 9999999.9_wp ) THEN
2838	n_vangenuchten = soil_pars(2,soil_type)
2839	ENDIF
2840
2841	IF ( hydraulic_conductivity == 9999999.9_wp ) THEN
2842	hydraulic_conductivity = soil_pars(3,soil_type)
2843	ENDIF
2844
2845	IF ( saturation_moisture == 9999999.9_wp ) THEN
2846	saturation_moisture = soil_pars(4,soil_type)
2847	ENDIF
2848
2849	IF ( field_capacity == 9999999.9_wp ) THEN
2850	field_capacity = soil_pars(5,soil_type)
2851	ENDIF
2852
2853	IF ( wilting_point == 9999999.9_wp ) THEN
2854	wilting_point = soil_pars(6,soil_type)
2855	ENDIF
2856
2857	IF ( residual_moisture == 9999999.9_wp ) THEN
2858	residual_moisture = soil_pars(7,soil_type)
2859	ENDIF
2860
2861	ENDIF
2862	!
2863	!-- Map values to the respective 2D/3D arrays
2864	!-- Horizontal surfaces
2865	surf_lsm_h%alpha_vg = alpha_vangenuchten
2866	surf_lsm_h%l_vg = l_vangenuchten
2867	surf_lsm_h%n_vg = n_vangenuchten
2868	surf_lsm_h%gamma_w_sat = hydraulic_conductivity
2869	surf_lsm_h%m_sat = saturation_moisture
2870	surf_lsm_h%m_fc = field_capacity
2871	surf_lsm_h%m_wilt = wilting_point
2872	surf_lsm_h%m_res = residual_moisture
2873	surf_lsm_h%r_soil_min = min_soil_resistance
2874	!
2875	!-- Vertical surfaces
2876	DO l = 0, 3
2877	surf_lsm_v(l)%alpha_vg = alpha_vangenuchten
2878	surf_lsm_v(l)%l_vg = l_vangenuchten
2879	surf_lsm_v(l)%n_vg = n_vangenuchten
2880	surf_lsm_v(l)%gamma_w_sat = hydraulic_conductivity
2881	surf_lsm_v(l)%m_sat = saturation_moisture
2882	surf_lsm_v(l)%m_fc = field_capacity
2883	surf_lsm_v(l)%m_wilt = wilting_point
2884	surf_lsm_v(l)%m_res = residual_moisture
2885	surf_lsm_v(l)%r_soil_min = min_soil_resistance
2886	ENDDO
2887	!
2888	!-- Level 2, initialization of soil parameters via soil_type read from file.
2889	!-- Soil parameters are initialized for each (y,x)-grid point
2890	!-- individually using default paramter settings according to the given
2891	!-- soil type.
2892	IF ( soil_type_f%from_file ) THEN
2893	!
2894	!-- Level of detail = 1, i.e. a homogeneous soil distribution along the
2895	!-- vertical dimension is assumed.
2896	IF ( soil_type_f%lod == 1 ) THEN
2897	!
2898	!-- Horizontal surfaces
2899	DO m = 1, surf_lsm_h%ns
2900	i = surf_lsm_h%i(m)
2901	j = surf_lsm_h%j(m)
2902
2903	st = soil_type_f%var_2d(j,i)
2904	IF ( st /= soil_type_f%fill ) THEN
2905	surf_lsm_h%alpha_vg(:,m) = soil_pars(0,st)
2906	surf_lsm_h%l_vg(:,m) = soil_pars(1,st)
2907	surf_lsm_h%n_vg(:,m) = soil_pars(2,st)
2908	surf_lsm_h%gamma_w_sat(:,m) = soil_pars(3,st)
2909	surf_lsm_h%m_sat(:,m) = soil_pars(4,st)
2910	surf_lsm_h%m_fc(:,m) = soil_pars(5,st)
2911	surf_lsm_h%m_wilt(:,m) = soil_pars(6,st)
2912	surf_lsm_h%m_res(:,m) = soil_pars(7,st)
2913	ENDIF
2914	ENDDO
2915	!
2916	!-- Vertical surfaces ( assumes the soil type given at respective (x,y)
2917	DO l = 0, 3
2918	DO m = 1, surf_lsm_v(l)%ns
2919	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
2920	surf_lsm_v(l)%building_covered(m) )
2921	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
2922	surf_lsm_v(l)%building_covered(m) )
2923
2924	st = soil_type_f%var_2d(j,i)
2925	IF ( st /= soil_type_f%fill ) THEN
2926	surf_lsm_v(l)%alpha_vg(:,m) = soil_pars(0,st)
2927	surf_lsm_v(l)%l_vg(:,m) = soil_pars(1,st)
2928	surf_lsm_v(l)%n_vg(:,m) = soil_pars(2,st)
2929	surf_lsm_v(l)%gamma_w_sat(:,m) = soil_pars(3,st)
2930	surf_lsm_v(l)%m_sat(:,m) = soil_pars(4,st)
2931	surf_lsm_v(l)%m_fc(:,m) = soil_pars(5,st)
2932	surf_lsm_v(l)%m_wilt(:,m) = soil_pars(6,st)
2933	surf_lsm_v(l)%m_res(:,m) = soil_pars(7,st)
2934	ENDIF
2935	ENDDO
2936	ENDDO
2937	!
2938	!-- Level of detail = 2, i.e. soil type and thus the soil parameters
2939	!-- can be heterogeneous along the vertical dimension.
2940	ELSE
2941	!
2942	!-- Horizontal surfaces
2943	DO m = 1, surf_lsm_h%ns
2944	i = surf_lsm_h%i(m)
2945	j = surf_lsm_h%j(m)
2946
2947	DO k = nzb_soil, nzt_soil
2948	st = soil_type_f%var_3d(k,j,i)
2949	IF ( st /= soil_type_f%fill ) THEN
2950	surf_lsm_h%alpha_vg(k,m) = soil_pars(0,st)
2951	surf_lsm_h%l_vg(k,m) = soil_pars(1,st)
2952	surf_lsm_h%n_vg(k,m) = soil_pars(2,st)
2953	surf_lsm_h%gamma_w_sat(k,m) = soil_pars(3,st)
2954	surf_lsm_h%m_sat(k,m) = soil_pars(4,st)
2955	surf_lsm_h%m_fc(k,m) = soil_pars(5,st)
2956	surf_lsm_h%m_wilt(k,m) = soil_pars(6,st)
2957	surf_lsm_h%m_res(k,m) = soil_pars(7,st)
2958	ENDIF
2959	ENDDO
2960	ENDDO
2961	!
2962	!-- Vertical surfaces ( assumes the soil type given at respective (x,y)
2963	DO l = 0, 3
2964	DO m = 1, surf_lsm_v(l)%ns
2965	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
2966	surf_lsm_v(l)%building_covered(m) )
2967	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
2968	surf_lsm_v(l)%building_covered(m) )
2969
2970	DO k = nzb_soil, nzt_soil
2971	st = soil_type_f%var_3d(k,j,i)
2972	IF ( st /= soil_type_f%fill ) THEN
2973	surf_lsm_v(l)%alpha_vg(k,m) = soil_pars(0,st)
2974	surf_lsm_v(l)%l_vg(k,m) = soil_pars(1,st)
2975	surf_lsm_v(l)%n_vg(k,m) = soil_pars(2,st)
2976	surf_lsm_v(l)%gamma_w_sat(k,m) = soil_pars(3,st)
2977	surf_lsm_v(l)%m_sat(k,m) = soil_pars(4,st)
2978	surf_lsm_v(l)%m_fc(k,m) = soil_pars(5,st)
2979	surf_lsm_v(l)%m_wilt(k,m) = soil_pars(6,st)
2980	surf_lsm_v(l)%m_res(k,m) = soil_pars(7,st)
2981	ENDIF
2982	ENDDO
2983	ENDDO
2984	ENDDO
2985	ENDIF
2986	ENDIF
2987	!
2988	!-- Level 3, initialization of single soil parameters at single z,x,y
2989	!-- position via soil_pars read from file.
2990	IF ( soil_pars_f%from_file ) THEN
2991	!
2992	!-- Level of detail = 1, i.e. a homogeneous vertical distribution of soil
2993	!-- parameters is assumed.
2994	!-- Horizontal surfaces
2995	IF ( soil_pars_f%lod == 1 ) THEN
2996	!
2997	!-- Horizontal surfaces
2998	DO m = 1, surf_lsm_h%ns
2999	i = surf_lsm_h%i(m)
3000	j = surf_lsm_h%j(m)
3001
3002	IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill ) &
3003	surf_lsm_h%alpha_vg(:,m) = soil_pars_f%pars_xy(0,j,i)
3004	IF ( soil_pars_f%pars_xy(1,j,i) /= soil_pars_f%fill ) &
3005	surf_lsm_h%l_vg(:,m) = soil_pars_f%pars_xy(1,j,i)
3006	IF ( soil_pars_f%pars_xy(2,j,i) /= soil_pars_f%fill ) &
3007	surf_lsm_h%n_vg(:,m) = soil_pars_f%pars_xy(2,j,i)
3008	IF ( soil_pars_f%pars_xy(3,j,i) /= soil_pars_f%fill ) &
3009	surf_lsm_h%gamma_w_sat(:,m) = soil_pars_f%pars_xy(3,j,i)
3010	IF ( soil_pars_f%pars_xy(4,j,i) /= soil_pars_f%fill ) &
3011	surf_lsm_h%m_sat(:,m) = soil_pars_f%pars_xy(4,j,i)
3012	IF ( soil_pars_f%pars_xy(5,j,i) /= soil_pars_f%fill ) &
3013	surf_lsm_h%m_fc(:,m) = soil_pars_f%pars_xy(5,j,i)
3014	IF ( soil_pars_f%pars_xy(6,j,i) /= soil_pars_f%fill ) &
3015	surf_lsm_h%m_wilt(:,m) = soil_pars_f%pars_xy(6,j,i)
3016	IF ( soil_pars_f%pars_xy(7,j,i) /= soil_pars_f%fill ) &
3017	surf_lsm_h%m_res(:,m) = soil_pars_f%pars_xy(7,j,i)
3018
3019	ENDDO
3020	!
3021	!-- Vertical surfaces
3022	DO l = 0, 3
3023	DO m = 1, surf_lsm_v(l)%ns
3024	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3025	surf_lsm_v(l)%building_covered(m) )
3026	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3027	surf_lsm_v(l)%building_covered(m) )
3028
3029	IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill ) &
3030	surf_lsm_v(l)%alpha_vg(:,m) = soil_pars_f%pars_xy(0,j,i)
3031	IF ( soil_pars_f%pars_xy(1,j,i) /= soil_pars_f%fill ) &
3032	surf_lsm_v(l)%l_vg(:,m) = soil_pars_f%pars_xy(1,j,i)
3033	IF ( soil_pars_f%pars_xy(2,j,i) /= soil_pars_f%fill ) &
3034	surf_lsm_v(l)%n_vg(:,m) = soil_pars_f%pars_xy(2,j,i)
3035	IF ( soil_pars_f%pars_xy(3,j,i) /= soil_pars_f%fill ) &
3036	surf_lsm_v(l)%gamma_w_sat(:,m) = soil_pars_f%pars_xy(3,j,i)
3037	IF ( soil_pars_f%pars_xy(4,j,i) /= soil_pars_f%fill ) &
3038	surf_lsm_v(l)%m_sat(:,m) = soil_pars_f%pars_xy(4,j,i)
3039	IF ( soil_pars_f%pars_xy(5,j,i) /= soil_pars_f%fill ) &
3040	surf_lsm_v(l)%m_fc(:,m) = soil_pars_f%pars_xy(5,j,i)
3041	IF ( soil_pars_f%pars_xy(6,j,i) /= soil_pars_f%fill ) &
3042	surf_lsm_v(l)%m_wilt(:,m) = soil_pars_f%pars_xy(6,j,i)
3043	IF ( soil_pars_f%pars_xy(7,j,i) /= soil_pars_f%fill ) &
3044	surf_lsm_v(l)%m_res(:,m) = soil_pars_f%pars_xy(7,j,i)
3045
3046	ENDDO
3047	ENDDO
3048	!
3049	!-- Level of detail = 2, i.e. soil parameters can be set at each soil
3050	!-- layer individually.
3051	ELSE
3052	!
3053	!-- Horizontal surfaces
3054	DO m = 1, surf_lsm_h%ns
3055	i = surf_lsm_h%i(m)
3056	j = surf_lsm_h%j(m)
3057
3058	DO k = nzb_soil, nzt_soil
3059	IF ( soil_pars_f%pars_xyz(0,k,j,i) /= soil_pars_f%fill ) &
3060	surf_lsm_h%alpha_vg(k,m) = soil_pars_f%pars_xyz(0,k,j,i)
3061	IF ( soil_pars_f%pars_xyz(1,k,j,i) /= soil_pars_f%fill ) &
3062	surf_lsm_h%l_vg(k,m) = soil_pars_f%pars_xyz(1,k,j,i)
3063	IF ( soil_pars_f%pars_xyz(2,k,j,i) /= soil_pars_f%fill ) &
3064	surf_lsm_h%n_vg(k,m) = soil_pars_f%pars_xyz(2,k,j,i)
3065	IF ( soil_pars_f%pars_xyz(3,k,j,i) /= soil_pars_f%fill ) &
3066	surf_lsm_h%gamma_w_sat(k,m) = soil_pars_f%pars_xyz(3,k,j,i)
3067	IF ( soil_pars_f%pars_xyz(4,k,j,i) /= soil_pars_f%fill ) &
3068	surf_lsm_h%m_sat(k,m) = soil_pars_f%pars_xyz(4,k,j,i)
3069	IF ( soil_pars_f%pars_xyz(5,k,j,i) /= soil_pars_f%fill ) &
3070	surf_lsm_h%m_fc(k,m) = soil_pars_f%pars_xyz(5,k,j,i)
3071	IF ( soil_pars_f%pars_xyz(6,k,j,i) /= soil_pars_f%fill ) &
3072	surf_lsm_h%m_wilt(k,m) = soil_pars_f%pars_xyz(6,k,j,i)
3073	IF ( soil_pars_f%pars_xyz(7,k,j,i) /= soil_pars_f%fill ) &
3074	surf_lsm_h%m_res(k,m) = soil_pars_f%pars_xyz(7,k,j,i)
3075	ENDDO
3076
3077	ENDDO
3078	!
3079	!-- Vertical surfaces
3080	DO l = 0, 3
3081	DO m = 1, surf_lsm_v(l)%ns
3082	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3083	surf_lsm_v(l)%building_covered(m) )
3084	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3085	surf_lsm_v(l)%building_covered(m) )
3086
3087	DO k = nzb_soil, nzt_soil
3088	IF ( soil_pars_f%pars_xyz(0,k,j,i) /= soil_pars_f%fill ) &
3089	surf_lsm_v(l)%alpha_vg(k,m) = soil_pars_f%pars_xyz(0,k,j,i)
3090	IF ( soil_pars_f%pars_xyz(1,k,j,i) /= soil_pars_f%fill ) &
3091	surf_lsm_v(l)%l_vg(k,m) = soil_pars_f%pars_xyz(1,k,j,i)
3092	IF ( soil_pars_f%pars_xyz(2,k,j,i) /= soil_pars_f%fill ) &
3093	surf_lsm_v(l)%n_vg(k,m) = soil_pars_f%pars_xyz(2,k,j,i)
3094	IF ( soil_pars_f%pars_xyz(3,k,j,i) /= soil_pars_f%fill ) &
3095	surf_lsm_v(l)%gamma_w_sat(k,m) = soil_pars_f%pars_xyz(3,k,j,i)
3096	IF ( soil_pars_f%pars_xyz(4,k,j,i) /= soil_pars_f%fill ) &
3097	surf_lsm_v(l)%m_sat(k,m) = soil_pars_f%pars_xyz(4,k,j,i)
3098	IF ( soil_pars_f%pars_xyz(5,k,j,i) /= soil_pars_f%fill ) &
3099	surf_lsm_v(l)%m_fc(k,m) = soil_pars_f%pars_xyz(5,k,j,i)
3100	IF ( soil_pars_f%pars_xyz(6,k,j,i) /= soil_pars_f%fill ) &
3101	surf_lsm_v(l)%m_wilt(k,m) = soil_pars_f%pars_xyz(6,k,j,i)
3102	IF ( soil_pars_f%pars_xyz(7,k,j,i) /= soil_pars_f%fill ) &
3103	surf_lsm_v(l)%m_res(k,m) = soil_pars_f%pars_xyz(7,k,j,i)
3104	ENDDO
3105
3106	ENDDO
3107	ENDDO
3108
3109	ENDIF
3110	ENDIF
3111
3112	!
3113	!-- Level 1, initialization of vegetation parameters. A horizontally
3114	!-- homogeneous distribution is assumed here.
3115	IF ( vegetation_type /= 0 ) THEN
3116
3117	IF ( min_canopy_resistance == 9999999.9_wp ) THEN
3118	min_canopy_resistance = vegetation_pars(ind_v_rc_min,vegetation_type)
3119	ENDIF
3120
3121	IF ( leaf_area_index == 9999999.9_wp ) THEN
3122	leaf_area_index = vegetation_pars(ind_v_rc_lai,vegetation_type)
3123	ENDIF
3124
3125	IF ( vegetation_coverage == 9999999.9_wp ) THEN
3126	vegetation_coverage = vegetation_pars(ind_v_c_veg,vegetation_type)
3127	ENDIF
3128
3129	IF ( canopy_resistance_coefficient == 9999999.9_wp ) THEN
3130	canopy_resistance_coefficient= vegetation_pars(ind_v_gd,vegetation_type)
3131	ENDIF
3132
3133	IF ( z0_vegetation == 9999999.9_wp ) THEN
3134	z0_vegetation = vegetation_pars(ind_v_z0,vegetation_type)
3135	ENDIF
3136
3137	IF ( z0h_vegetation == 9999999.9_wp ) THEN
3138	z0h_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type)
3139	ENDIF
3140
3141	IF ( z0q_vegetation == 9999999.9_wp ) THEN
3142	z0q_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type)
3143	ENDIF
3144
3145	IF ( lambda_surface_stable == 9999999.9_wp ) THEN
3146	lambda_surface_stable = vegetation_pars(ind_v_lambda_s,vegetation_type)
3147	ENDIF
3148
3149	IF ( lambda_surface_unstable == 9999999.9_wp ) THEN
3150	lambda_surface_unstable = vegetation_pars(ind_v_lambda_u,vegetation_type)
3151	ENDIF
3152
3153	IF ( f_shortwave_incoming == 9999999.9_wp ) THEN
3154	f_shortwave_incoming = vegetation_pars(ind_v_f_sw_in,vegetation_type)
3155	ENDIF
3156
3157	IF ( c_surface == 9999999.9_wp ) THEN
3158	c_surface = vegetation_pars(ind_v_c_surf,vegetation_type)
3159	ENDIF
3160
3161	IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN
3162	albedo_type = INT(vegetation_pars(ind_v_at,vegetation_type))
3163	ENDIF
3164
3165	IF ( emissivity == 9999999.9_wp ) THEN
3166	emissivity = vegetation_pars(ind_v_emis,vegetation_type)
3167	ENDIF
3168
3169	ENDIF
3170	!
3171	!-- Map values onto horizontal elemements
3172	DO m = 1, surf_lsm_h%ns
3173	IF ( surf_lsm_h%vegetation_surface(m) ) THEN
3174	surf_lsm_h%r_canopy_min(m) = min_canopy_resistance
3175	surf_lsm_h%lai(m) = leaf_area_index
3176	surf_lsm_h%c_veg(m) = vegetation_coverage
3177	surf_lsm_h%g_d(m) = canopy_resistance_coefficient
3178	surf_lsm_h%z0(m) = z0_vegetation
3179	surf_lsm_h%z0h(m) = z0h_vegetation
3180	surf_lsm_h%z0q(m) = z0q_vegetation
3181	surf_lsm_h%lambda_surface_s(m) = lambda_surface_stable
3182	surf_lsm_h%lambda_surface_u(m) = lambda_surface_unstable
3183	surf_lsm_h%f_sw_in(m) = f_shortwave_incoming
3184	surf_lsm_h%c_surface(m) = c_surface
3185	surf_lsm_h%albedo_type(ind_veg_wall,m) = albedo_type
3186	surf_lsm_h%emissivity(ind_veg_wall,m) = emissivity
3187
3188	surf_lsm_h%vegetation_type(m) = vegetation_type
3189	surf_lsm_h%vegetation_type_name(m) = vegetation_type_name(vegetation_type)
3190	ELSE
3191	surf_lsm_h%lai(m) = 0.0_wp
3192	surf_lsm_h%c_veg(m) = 0.0_wp
3193	surf_lsm_h%g_d(m) = 0.0_wp
3194	ENDIF
3195
3196	ENDDO
3197	!
3198	!-- Map values onto vertical elements, even though this does not make
3199	!-- much sense.
3200	DO l = 0, 3
3201	DO m = 1, surf_lsm_v(l)%ns
3202	IF ( surf_lsm_v(l)%vegetation_surface(m) ) THEN
3203	surf_lsm_v(l)%r_canopy_min(m) = min_canopy_resistance
3204	surf_lsm_v(l)%lai(m) = leaf_area_index
3205	surf_lsm_v(l)%c_veg(m) = vegetation_coverage
3206	surf_lsm_v(l)%g_d(m) = canopy_resistance_coefficient
3207	surf_lsm_v(l)%z0(m) = z0_vegetation
3208	surf_lsm_v(l)%z0h(m) = z0h_vegetation
3209	surf_lsm_v(l)%z0q(m) = z0q_vegetation
3210	surf_lsm_v(l)%lambda_surface_s(m) = lambda_surface_stable
3211	surf_lsm_v(l)%lambda_surface_u(m) = lambda_surface_unstable
3212	surf_lsm_v(l)%f_sw_in(m) = f_shortwave_incoming
3213	surf_lsm_v(l)%c_surface(m) = c_surface
3214	surf_lsm_v(l)%albedo_type(ind_veg_wall,m) = albedo_type
3215	surf_lsm_v(l)%emissivity(ind_veg_wall,m) = emissivity
3216
3217	surf_lsm_v(l)%vegetation_type(m) = vegetation_type
3218	surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(vegetation_type)
3219	ELSE
3220	surf_lsm_v(l)%lai(m) = 0.0_wp
3221	surf_lsm_v(l)%c_veg(m) = 0.0_wp
3222	surf_lsm_v(l)%g_d(m) = 0.0_wp
3223	ENDIF
3224	ENDDO
3225	ENDDO
3226
3227	!
3228	!-- Level 2, initialization of vegation parameters via vegetation_type read
3229	!-- from file. Vegetation parameters are initialized for each (y,x)-grid point
3230	!-- individually using default paramter settings according to the given
3231	!-- vegetation type.
3232	IF ( vegetation_type_f%from_file ) THEN
3233	!
3234	!-- Horizontal surfaces
3235	DO m = 1, surf_lsm_h%ns
3236	i = surf_lsm_h%i(m)
3237	j = surf_lsm_h%j(m)
3238
3239	st = vegetation_type_f%var(j,i)
3240	IF ( st /= vegetation_type_f%fill .AND. st /= 0 ) THEN
3241	surf_lsm_h%r_canopy_min(m) = vegetation_pars(ind_v_rc_min,st)
3242	surf_lsm_h%lai(m) = vegetation_pars(ind_v_rc_lai,st)
3243	surf_lsm_h%c_veg(m) = vegetation_pars(ind_v_c_veg,st)
3244	surf_lsm_h%g_d(m) = vegetation_pars(ind_v_gd,st)
3245	surf_lsm_h%z0(m) = vegetation_pars(ind_v_z0,st)
3246	surf_lsm_h%z0h(m) = vegetation_pars(ind_v_z0qh,st)
3247	surf_lsm_h%z0q(m) = vegetation_pars(ind_v_z0qh,st)
3248	surf_lsm_h%lambda_surface_s(m) = vegetation_pars(ind_v_lambda_s,st)
3249	surf_lsm_h%lambda_surface_u(m) = vegetation_pars(ind_v_lambda_u,st)
3250	surf_lsm_h%f_sw_in(m) = vegetation_pars(ind_v_f_sw_in,st)
3251	surf_lsm_h%c_surface(m) = vegetation_pars(ind_v_c_surf,st)
3252	surf_lsm_h%albedo_type(ind_veg_wall,m) = INT( vegetation_pars(ind_v_at,st) )
3253	surf_lsm_h%emissivity(ind_veg_wall,m) = vegetation_pars(ind_v_emis,st)
3254
3255	surf_lsm_h%vegetation_type(m) = st
3256	surf_lsm_h%vegetation_type_name(m) = vegetation_type_name(st)
3257	ENDIF
3258	ENDDO
3259	!
3260	!-- Vertical surfaces
3261	DO l = 0, 3
3262	DO m = 1, surf_lsm_v(l)%ns
3263	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3264	surf_lsm_v(l)%building_covered(m) )
3265	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3266	surf_lsm_v(l)%building_covered(m) )
3267
3268	st = vegetation_type_f%var(j,i)
3269	IF ( st /= vegetation_type_f%fill .AND. st /= 0 ) THEN
3270	surf_lsm_v(l)%r_canopy_min(m) = vegetation_pars(ind_v_rc_min,st)
3271	surf_lsm_v(l)%lai(m) = vegetation_pars(ind_v_rc_lai,st)
3272	surf_lsm_v(l)%c_veg(m) = vegetation_pars(ind_v_c_veg,st)
3273	surf_lsm_v(l)%g_d(m) = vegetation_pars(ind_v_gd,st)
3274	surf_lsm_v(l)%z0(m) = vegetation_pars(ind_v_z0,st)
3275	surf_lsm_v(l)%z0h(m) = vegetation_pars(ind_v_z0qh,st)
3276	surf_lsm_v(l)%z0q(m) = vegetation_pars(ind_v_z0qh,st)
3277	surf_lsm_v(l)%lambda_surface_s(m) = vegetation_pars(ind_v_lambda_s,st)
3278	surf_lsm_v(l)%lambda_surface_u(m) = vegetation_pars(ind_v_lambda_u,st)
3279	surf_lsm_v(l)%f_sw_in(m) = vegetation_pars(ind_v_f_sw_in,st)
3280	surf_lsm_v(l)%c_surface(m) = vegetation_pars(ind_v_c_surf,st)
3281	surf_lsm_v(l)%albedo_type(ind_veg_wall,m) = INT( vegetation_pars(ind_v_at,st) )
3282	surf_lsm_v(l)%emissivity(ind_veg_wall,m) = vegetation_pars(ind_v_emis,st)
3283
3284	surf_lsm_v(l)%vegetation_type(m) = st
3285	surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(st)
3286	ENDIF
3287	ENDDO
3288	ENDDO
3289	ENDIF
3290	!
3291	!-- Level 3, initialization of vegation parameters at single (x,y)
3292	!-- position via vegetation_pars read from file.
3293	IF ( vegetation_pars_f%from_file ) THEN
3294	!
3295	!-- Horizontal surfaces
3296	DO m = 1, surf_lsm_h%ns
3297
3298	i = surf_lsm_h%i(m)
3299	j = surf_lsm_h%j(m)
3300	!
3301	!-- If surface element is not a vegetation surface and any value in
3302	!-- vegetation_pars is given, neglect this information and give an
3303	!-- informative message that this value will not be used.
3304	IF ( .NOT. surf_lsm_h%vegetation_surface(m) .AND. &
3305	ANY( vegetation_pars_f%pars_xy(:,j,i) /= &
3306	vegetation_pars_f%fill ) ) THEN
3307	WRITE( message_string, * ) &
3308	'surface element at grid point (j,i) = (', &
3309	j, i, ') is not a vegetation surface, ', &
3310	'so that information given in ', &
3311	'vegetation_pars at this point is neglected.'
3312	CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 )
3313	ELSE
3314
3315	IF ( vegetation_pars_f%pars_xy(ind_v_rc_min,j,i) /= &
3316	vegetation_pars_f%fill ) &
3317	surf_lsm_h%r_canopy_min(m) = &
3318	vegetation_pars_f%pars_xy(ind_v_rc_min,j,i)
3319	IF ( vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i) /= &
3320	vegetation_pars_f%fill ) &
3321	surf_lsm_h%lai(m) = &
3322	vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i)
3323	IF ( vegetation_pars_f%pars_xy(ind_v_c_veg,j,i) /= &
3324	vegetation_pars_f%fill ) &
3325	surf_lsm_h%c_veg(m) = &
3326	vegetation_pars_f%pars_xy(ind_v_c_veg,j,i)
3327	IF ( vegetation_pars_f%pars_xy(ind_v_gd,j,i) /= &
3328	vegetation_pars_f%fill ) &
3329	surf_lsm_h%g_d(m) = &
3330	vegetation_pars_f%pars_xy(ind_v_gd,j,i)
3331	IF ( vegetation_pars_f%pars_xy(ind_v_z0,j,i) /= &
3332	vegetation_pars_f%fill ) &
3333	surf_lsm_h%z0(m) = &
3334	vegetation_pars_f%pars_xy(ind_v_z0,j,i)
3335	IF ( vegetation_pars_f%pars_xy(ind_v_z0qh,j,i) /= &
3336	vegetation_pars_f%fill ) THEN
3337	surf_lsm_h%z0h(m) = &
3338	vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
3339	surf_lsm_h%z0q(m) = &
3340	vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
3341	ENDIF
3342	IF ( vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i) /= &
3343	vegetation_pars_f%fill ) &
3344	surf_lsm_h%lambda_surface_s(m) = &
3345	vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i)
3346	IF ( vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i) /= &
3347	vegetation_pars_f%fill ) &
3348	surf_lsm_h%lambda_surface_u(m) = &
3349	vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i)
3350	IF ( vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i) /= &
3351	vegetation_pars_f%fill ) &
3352	surf_lsm_h%f_sw_in(m) = &
3353	vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i)
3354	IF ( vegetation_pars_f%pars_xy(ind_v_c_surf,j,i) /= &
3355	vegetation_pars_f%fill ) &
3356	surf_lsm_h%c_surface(m) = &
3357	vegetation_pars_f%pars_xy(ind_v_c_surf,j,i)
3358	IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= &
3359	vegetation_pars_f%fill ) &
3360	surf_lsm_h%albedo_type(ind_veg_wall,m) = &
3361	INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) )
3362	IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= &
3363	vegetation_pars_f%fill ) &
3364	surf_lsm_h%emissivity(ind_veg_wall,m) = &
3365	vegetation_pars_f%pars_xy(ind_v_emis,j,i)
3366	ENDIF
3367	ENDDO
3368	!
3369	!-- Vertical surfaces
3370	DO l = 0, 3
3371	DO m = 1, surf_lsm_v(l)%ns
3372	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3373	surf_lsm_v(l)%building_covered(m) )
3374	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3375	surf_lsm_v(l)%building_covered(m) )
3376	!
3377	!-- If surface element is not a vegetation surface and any value in
3378	!-- vegetation_pars is given, neglect this information and give an
3379	!-- informative message that this value will not be used.
3380	IF ( .NOT. surf_lsm_v(l)%vegetation_surface(m) .AND. &
3381	ANY( vegetation_pars_f%pars_xy(:,j,i) /= &
3382	vegetation_pars_f%fill ) ) THEN
3383	WRITE( message_string, * ) &
3384	'surface element at grid point (j,i) = (', &
3385	j, i, ') is not a vegetation surface, ', &
3386	'so that information given in ', &
3387	'vegetation_pars at this point is neglected.'
3388	CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 )
3389	ELSE
3390
3391	IF ( vegetation_pars_f%pars_xy(ind_v_rc_min,j,i) /= &
3392	vegetation_pars_f%fill ) &
3393	surf_lsm_v(l)%r_canopy_min(m) = &
3394	vegetation_pars_f%pars_xy(ind_v_rc_min,j,i)
3395	IF ( vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i) /= &
3396	vegetation_pars_f%fill ) &
3397	surf_lsm_v(l)%lai(m) = &
3398	vegetation_pars_f%pars_xy(ind_v_rc_lai,j,i)
3399	IF ( vegetation_pars_f%pars_xy(ind_v_c_veg,j,i) /= &
3400	vegetation_pars_f%fill ) &
3401	surf_lsm_v(l)%c_veg(m) = &
3402	vegetation_pars_f%pars_xy(ind_v_c_veg,j,i)
3403	IF ( vegetation_pars_f%pars_xy(ind_v_gd,j,i) /= &
3404	vegetation_pars_f%fill ) &
3405	surf_lsm_v(l)%g_d(m) = &
3406	vegetation_pars_f%pars_xy(ind_v_gd,j,i)
3407	IF ( vegetation_pars_f%pars_xy(ind_v_z0,j,i) /= &
3408	vegetation_pars_f%fill ) &
3409	surf_lsm_v(l)%z0(m) = &
3410	vegetation_pars_f%pars_xy(ind_v_z0,j,i)
3411	IF ( vegetation_pars_f%pars_xy(ind_v_z0qh,j,i) /= &
3412	vegetation_pars_f%fill ) THEN
3413	surf_lsm_v(l)%z0h(m) = &
3414	vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
3415	surf_lsm_v(l)%z0q(m) = &
3416	vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
3417	ENDIF
3418	IF ( vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i) /= &
3419	vegetation_pars_f%fill ) &
3420	surf_lsm_v(l)%lambda_surface_s(m) = &
3421	vegetation_pars_f%pars_xy(ind_v_lambda_s,j,i)
3422	IF ( vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i) /= &
3423	vegetation_pars_f%fill ) &
3424	surf_lsm_v(l)%lambda_surface_u(m) = &
3425	vegetation_pars_f%pars_xy(ind_v_lambda_u,j,i)
3426	IF ( vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i) /= &
3427	vegetation_pars_f%fill ) &
3428	surf_lsm_v(l)%f_sw_in(m) = &
3429	vegetation_pars_f%pars_xy(ind_v_f_sw_in,j,i)
3430	IF ( vegetation_pars_f%pars_xy(ind_v_c_surf,j,i) /= &
3431	vegetation_pars_f%fill ) &
3432	surf_lsm_v(l)%c_surface(m) = &
3433	vegetation_pars_f%pars_xy(ind_v_c_surf,j,i)
3434	IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= &
3435	vegetation_pars_f%fill ) &
3436	surf_lsm_v(l)%albedo_type(ind_veg_wall,m) = &
3437	INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) )
3438	IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= &
3439	vegetation_pars_f%fill ) &
3440	surf_lsm_v(l)%emissivity(ind_veg_wall,m) = &
3441	vegetation_pars_f%pars_xy(ind_v_emis,j,i)
3442	ENDIF
3443
3444	ENDDO
3445	ENDDO
3446	ENDIF
3447
3448	!
3449	!-- Level 1, initialization of water parameters. A horizontally
3450	!-- homogeneous distribution is assumed here.
3451	IF ( water_type /= 0 ) THEN
3452
3453	IF ( water_temperature == 9999999.9_wp ) THEN
3454	water_temperature = water_pars(ind_w_temp,water_type)
3455	ENDIF
3456
3457	IF ( z0_water == 9999999.9_wp ) THEN
3458	z0_water = water_pars(ind_w_z0,water_type)
3459	ENDIF
3460
3461	IF ( z0h_water == 9999999.9_wp ) THEN
3462	z0h_water = water_pars(ind_w_z0h,water_type)
3463	ENDIF
3464
3465	IF ( z0q_water == 9999999.9_wp ) THEN
3466	z0q_water = water_pars(ind_w_z0h,water_type)
3467	ENDIF
3468
3469	IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN
3470	albedo_type = INT(water_pars(ind_w_at,water_type))
3471	ENDIF
3472
3473	IF ( emissivity == 9999999.9_wp ) THEN
3474	emissivity = water_pars(ind_w_emis,water_type)
3475	ENDIF
3476
3477	ENDIF
3478	!
3479	!-- Map values onto horizontal elemements
3480	DO m = 1, surf_lsm_h%ns
3481	IF ( surf_lsm_h%water_surface(m) ) THEN
3482	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) &
3483	t_soil_h%var_2d(:,m) = water_temperature
3484	surf_lsm_h%z0(m) = z0_water
3485	surf_lsm_h%z0h(m) = z0h_water
3486	surf_lsm_h%z0q(m) = z0q_water
3487	surf_lsm_h%lambda_surface_s(m) = 1.0E10_wp
3488	surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp
3489	surf_lsm_h%c_surface(m) = 0.0_wp
3490	surf_lsm_h%albedo_type(ind_wat_win,m) = albedo_type
3491	surf_lsm_h%emissivity(ind_wat_win,m) = emissivity
3492
3493	surf_lsm_h%water_type(m) = water_type
3494	surf_lsm_h%water_type_name(m) = water_type_name(water_type)
3495	ENDIF
3496	ENDDO
3497	!
3498	!-- Map values onto vertical elements, even though this does not make
3499	!-- much sense.
3500	DO l = 0, 3
3501	DO m = 1, surf_lsm_v(l)%ns
3502	IF ( surf_lsm_v(l)%water_surface(m) ) THEN
3503	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) &
3504	t_soil_v(l)%var_2d(:,m) = water_temperature
3505	surf_lsm_v(l)%z0(m) = z0_water
3506	surf_lsm_v(l)%z0h(m) = z0h_water
3507	surf_lsm_v(l)%z0q(m) = z0q_water
3508	surf_lsm_v(l)%lambda_surface_s(m) = 1.0E10_wp
3509	surf_lsm_v(l)%lambda_surface_u(m) = 1.0E10_wp
3510	surf_lsm_v(l)%c_surface(m) = 0.0_wp
3511	surf_lsm_v(l)%albedo_type(ind_wat_win,m) = albedo_type
3512	surf_lsm_v(l)%emissivity(ind_wat_win,m) = emissivity
3513
3514	surf_lsm_v(l)%water_type(m) = water_type
3515	surf_lsm_v(l)%water_type_name(m) = water_type_name(water_type)
3516	ENDIF
3517	ENDDO
3518	ENDDO
3519	!
3520	!
3521	!-- Level 2, initialization of water parameters via water_type read
3522	!-- from file. Water surfaces are initialized for each (y,x)-grid point
3523	!-- individually using default paramter settings according to the given
3524	!-- water type.
3525	!-- Note, parameter 3/4 of water_pars are albedo and emissivity,
3526	!-- whereas paramter 3/4 of water_pars_f are heat conductivities!
3527	IF ( water_type_f%from_file ) THEN
3528	!
3529	!-- Horizontal surfaces
3530	DO m = 1, surf_lsm_h%ns
3531	i = surf_lsm_h%i(m)
3532	j = surf_lsm_h%j(m)
3533
3534	st = water_type_f%var(j,i)
3535	IF ( st /= water_type_f%fill .AND. st /= 0 ) THEN
3536	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) &
3537	t_soil_h%var_2d(:,m) = water_pars(ind_w_temp,st)
3538	surf_lsm_h%z0(m) = water_pars(ind_w_z0,st)
3539	surf_lsm_h%z0h(m) = water_pars(ind_w_z0h,st)
3540	surf_lsm_h%z0q(m) = water_pars(ind_w_z0h,st)
3541	surf_lsm_h%lambda_surface_s(m) = water_pars(ind_w_lambda_s,st)
3542	surf_lsm_h%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st)
3543	surf_lsm_h%c_surface(m) = 0.0_wp
3544	surf_lsm_h%albedo_type(ind_wat_win,m) = INT( water_pars(ind_w_at,st) )
3545	surf_lsm_h%emissivity(ind_wat_win,m) = water_pars(ind_w_emis,st)
3546
3547	surf_lsm_h%water_type(m) = st
3548	surf_lsm_h%water_type_name(m) = water_type_name(st)
3549	ENDIF
3550	ENDDO
3551	!
3552	!-- Vertical surfaces
3553	DO l = 0, 3
3554	DO m = 1, surf_lsm_v(l)%ns
3555	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3556	surf_lsm_v(l)%building_covered(m) )
3557	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3558	surf_lsm_v(l)%building_covered(m) )
3559
3560	st = water_type_f%var(j,i)
3561	IF ( st /= water_type_f%fill .AND. st /= 0 ) THEN
3562	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) &
3563	t_soil_v(l)%var_2d(:,m) = water_pars(ind_w_temp,st)
3564	surf_lsm_v(l)%z0(m) = water_pars(ind_w_z0,st)
3565	surf_lsm_v(l)%z0h(m) = water_pars(ind_w_z0h,st)
3566	surf_lsm_v(l)%z0q(m) = water_pars(ind_w_z0h,st)
3567	surf_lsm_v(l)%lambda_surface_s(m) = &
3568	water_pars(ind_w_lambda_s,st)
3569	surf_lsm_v(l)%lambda_surface_u(m) = &
3570	water_pars(ind_w_lambda_u,st)
3571	surf_lsm_v(l)%c_surface(m) = 0.0_wp
3572	surf_lsm_v(l)%albedo_type(ind_wat_win,m) = &
3573	INT( water_pars(ind_w_at,st) )
3574	surf_lsm_v(l)%emissivity(ind_wat_win,m) = &
3575	water_pars(ind_w_emis,st)
3576
3577	surf_lsm_v(l)%water_type(m) = st
3578	surf_lsm_v(l)%water_type_name(m) = water_type_name(st)
3579	ENDIF
3580	ENDDO
3581	ENDDO
3582	ENDIF
3583
3584	!
3585	!-- Level 3, initialization of water parameters at single (x,y)
3586	!-- position via water_pars read from file.
3587	IF ( water_pars_f%from_file ) THEN
3588	!
3589	!-- Horizontal surfaces
3590	DO m = 1, surf_lsm_h%ns
3591	i = surf_lsm_h%i(m)
3592	j = surf_lsm_h%j(m)
3593	!
3594	!-- If surface element is not a water surface and any value in
3595	!-- water_pars is given, neglect this information and give an
3596	!-- informative message that this value will not be used.
3597	IF ( .NOT. surf_lsm_h%water_surface(m) .AND. &
3598	ANY( water_pars_f%pars_xy(:,j,i) /= water_pars_f%fill ) ) THEN
3599	WRITE( message_string, * ) &
3600	'surface element at grid point (j,i) = (', &
3601	j, i, ') is not a water surface, ', &
3602	'so that information given in ', &
3603	'water_pars at this point is neglected.'
3604	CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 )
3605	ELSE
3606	IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /= &
3607	water_pars_f%fill .AND. &
3608	TRIM( initializing_actions ) /= 'read_restart_data' ) &
3609	t_soil_h%var_2d(:,m) = water_pars_f%pars_xy(ind_w_temp,j,i)
3610
3611	IF ( water_pars_f%pars_xy(ind_w_z0,j,i) /= water_pars_f%fill ) &
3612	surf_lsm_h%z0(m) = water_pars_f%pars_xy(ind_w_z0,j,i)
3613
3614	IF ( water_pars_f%pars_xy(ind_w_z0h,j,i) /= water_pars_f%fill )&
3615	THEN
3616	surf_lsm_h%z0h(m) = water_pars_f%pars_xy(ind_w_z0h,j,i)
3617	surf_lsm_h%z0q(m) = water_pars_f%pars_xy(ind_w_z0h,j,i)
3618	ENDIF
3619	IF ( water_pars_f%pars_xy(ind_w_lambda_s,j,i) /= &
3620	water_pars_f%fill ) &
3621	surf_lsm_h%lambda_surface_s(m) = &
3622	water_pars_f%pars_xy(ind_w_lambda_s,j,i)
3623
3624	IF ( water_pars_f%pars_xy(ind_w_lambda_u,j,i) /= &
3625	water_pars_f%fill ) &
3626	surf_lsm_h%lambda_surface_u(m) = &
3627	water_pars_f%pars_xy(ind_w_lambda_u,j,i)
3628
3629	IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= &
3630	water_pars_f%fill ) &
3631	surf_lsm_h%albedo_type(ind_wat_win,m) = &
3632	INT( water_pars_f%pars_xy(ind_w_at,j,i) )
3633
3634	IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= &
3635	water_pars_f%fill ) &
3636	surf_lsm_h%emissivity(ind_wat_win,m) = &
3637	water_pars_f%pars_xy(ind_w_emis,j,i)
3638	ENDIF
3639	ENDDO
3640	!
3641	!-- Vertical surfaces
3642	DO l = 0, 3
3643	DO m = 1, surf_lsm_v(l)%ns
3644	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3645	surf_lsm_v(l)%building_covered(m) )
3646	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3647	surf_lsm_v(l)%building_covered(m) )
3648	!
3649	!-- If surface element is not a water surface and any value in
3650	!-- water_pars is given, neglect this information and give an
3651	!-- informative message that this value will not be used.
3652	IF ( .NOT. surf_lsm_v(l)%water_surface(m) .AND. &
3653	ANY( water_pars_f%pars_xy(:,j,i) /= &
3654	water_pars_f%fill ) ) THEN
3655	WRITE( message_string, * ) &
3656	'surface element at grid point (j,i) = (', &
3657	j, i, ') is not a water surface, ', &
3658	'so that information given in ', &
3659	'water_pars at this point is neglected.'
3660	CALL message( 'land_surface_model_mod', 'PA0645', &
3661	0, 0, myid, 6, 0 )
3662	ELSE
3663
3664	IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /= &
3665	water_pars_f%fill .AND. &
3666	TRIM( initializing_actions ) /= 'read_restart_data' ) &
3667	t_soil_v(l)%var_2d(:,m) = water_pars_f%pars_xy(ind_w_temp,j,i)
3668
3669	IF ( water_pars_f%pars_xy(ind_w_z0,j,i) /= &
3670	water_pars_f%fill ) &
3671	surf_lsm_v(l)%z0(m) = water_pars_f%pars_xy(ind_w_z0,j,i)
3672
3673	IF ( water_pars_f%pars_xy(ind_w_z0h,j,i) /= &
3674	water_pars_f%fill ) THEN
3675	surf_lsm_v(l)%z0h(m) = water_pars_f%pars_xy(ind_w_z0h,j,i)
3676	surf_lsm_v(l)%z0q(m) = water_pars_f%pars_xy(ind_w_z0h,j,i)
3677	ENDIF
3678
3679	IF ( water_pars_f%pars_xy(ind_w_lambda_s,j,i) /= &
3680	water_pars_f%fill ) &
3681	surf_lsm_v(l)%lambda_surface_s(m) = &
3682	water_pars_f%pars_xy(ind_w_lambda_s,j,i)
3683
3684	IF ( water_pars_f%pars_xy(ind_w_lambda_u,j,i) /= &
3685	water_pars_f%fill ) &
3686	surf_lsm_v(l)%lambda_surface_u(m) = &
3687	water_pars_f%pars_xy(ind_w_lambda_u,j,i)
3688
3689	IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= &
3690	water_pars_f%fill ) &
3691	surf_lsm_v(l)%albedo_type(ind_wat_win,m) = &
3692	INT( water_pars_f%pars_xy(ind_w_at,j,i) )
3693
3694	IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= &
3695	water_pars_f%fill ) &
3696	surf_lsm_v(l)%emissivity(ind_wat_win,m) = &
3697	water_pars_f%pars_xy(ind_w_emis,j,i)
3698	ENDIF
3699	ENDDO
3700	ENDDO
3701
3702	ENDIF
3703	!
3704	!-- Initialize pavement-type surfaces, level 1
3705	IF ( pavement_type /= 0 ) THEN
3706
3707	!
3708	!-- When a pavement_type is used, overwrite a possible setting of
3709	!-- the pavement depth as it is already defined by the pavement type
3710	pavement_depth_level = 0
3711
3712	IF ( z0_pavement == 9999999.9_wp ) THEN
3713	z0_pavement = pavement_pars(ind_p_z0,pavement_type)
3714	ENDIF
3715
3716	IF ( z0h_pavement == 9999999.9_wp ) THEN
3717	z0h_pavement = pavement_pars(ind_p_z0h,pavement_type)
3718	ENDIF
3719
3720	IF ( z0q_pavement == 9999999.9_wp ) THEN
3721	z0q_pavement = pavement_pars(ind_p_z0h,pavement_type)
3722	ENDIF
3723
3724	IF ( pavement_heat_conduct == 9999999.9_wp ) THEN
3725	pavement_heat_conduct = pavement_subsurface_pars_1(0,pavement_type)
3726	ENDIF
3727
3728	IF ( pavement_heat_capacity == 9999999.9_wp ) THEN
3729	pavement_heat_capacity = pavement_subsurface_pars_2(0,pavement_type)
3730	ENDIF
3731
3732	IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN
3733	albedo_type = INT(pavement_pars(ind_p_at,pavement_type))
3734	ENDIF
3735
3736	IF ( emissivity == 9999999.9_wp ) THEN
3737	emissivity = pavement_pars(ind_p_emis,pavement_type)
3738	ENDIF
3739
3740	!
3741	!-- If the depth level of the pavement is not set, determine it from
3742	!-- lookup table.
3743	IF ( pavement_depth_level == 0 ) THEN
3744	DO k = nzb_soil, nzt_soil
3745	IF ( pavement_subsurface_pars_1(k,pavement_type) == 9999999.9_wp &
3746	.OR. pavement_subsurface_pars_2(k,pavement_type) == 9999999.9_wp)&
3747	THEN
3748	nzt_pavement = k-1
3749	EXIT
3750	ENDIF
3751	ENDDO
3752	ELSE
3753	nzt_pavement = pavement_depth_level
3754	ENDIF
3755
3756	ENDIF
3757	!
3758	!-- Level 1 initialization of pavement type surfaces. Horizontally
3759	!-- homogeneous characteristics are assumed
3760	surf_lsm_h%nzt_pavement = pavement_depth_level
3761	DO m = 1, surf_lsm_h%ns
3762	IF ( surf_lsm_h%pavement_surface(m) ) THEN
3763	surf_lsm_h%nzt_pavement(m) = nzt_pavement
3764	surf_lsm_h%z0(m) = z0_pavement
3765	surf_lsm_h%z0h(m) = z0h_pavement
3766	surf_lsm_h%z0q(m) = z0q_pavement
3767	surf_lsm_h%lambda_surface_s(m) = pavement_heat_conduct &
3768	* ddz_soil(nzb_soil) &
3769	* 2.0_wp
3770	surf_lsm_h%lambda_surface_u(m) = pavement_heat_conduct &
3771	* ddz_soil(nzb_soil) &
3772	* 2.0_wp
3773	surf_lsm_h%c_surface(m) = pavement_heat_capacity &
3774	* dz_soil(nzb_soil) &
3775	* 0.25_wp
3776
3777	surf_lsm_h%albedo_type(ind_pav_green,m) = albedo_type
3778	surf_lsm_h%emissivity(ind_pav_green,m) = emissivity
3779
3780	surf_lsm_h%pavement_type(m) = pavement_type
3781	surf_lsm_h%pavement_type_name(m) = pavement_type_name(pavement_type)
3782
3783	IF ( pavement_type /= 0 ) THEN
3784	DO k = nzb_soil, surf_lsm_h%nzt_pavement(m)
3785	surf_lsm_h%lambda_h_def(k,m) = &
3786	pavement_subsurface_pars_1(k,pavement_type)
3787	surf_lsm_h%rho_c_total_def(k,m) = &
3788	pavement_subsurface_pars_2(k,pavement_type)
3789	ENDDO
3790	ELSE
3791	surf_lsm_h%lambda_h_def(:,m) = pavement_heat_conduct
3792	surf_lsm_h%rho_c_total_def(:,m) = pavement_heat_capacity
3793	ENDIF
3794	ENDIF
3795	ENDDO
3796
3797	DO l = 0, 3
3798	surf_lsm_v(l)%nzt_pavement = pavement_depth_level
3799	DO m = 1, surf_lsm_v(l)%ns
3800	IF ( surf_lsm_v(l)%pavement_surface(m) ) THEN
3801	surf_lsm_v(l)%nzt_pavement(m) = nzt_pavement
3802	surf_lsm_v(l)%z0(m) = z0_pavement
3803	surf_lsm_v(l)%z0h(m) = z0h_pavement
3804	surf_lsm_v(l)%z0q(m) = z0q_pavement
3805	surf_lsm_v(l)%lambda_surface_s(m) = pavement_heat_conduct &
3806	* ddz_soil(nzb_soil) &
3807	* 2.0_wp
3808	surf_lsm_v(l)%lambda_surface_u(m) = pavement_heat_conduct &
3809	* ddz_soil(nzb_soil) &
3810	* 2.0_wp
3811	surf_lsm_v(l)%c_surface(m) = pavement_heat_capacity &
3812	* dz_soil(nzb_soil) &
3813	* 0.25_wp
3814
3815	surf_lsm_v(l)%albedo_type(ind_pav_green,m) = albedo_type
3816	surf_lsm_v(l)%emissivity(ind_pav_green,m) = emissivity
3817
3818	surf_lsm_v(l)%pavement_type(m) = pavement_type
3819	surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(pavement_type)
3820
3821	IF ( pavement_type /= 0 ) THEN
3822	DO k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m)
3823	surf_lsm_v(l)%lambda_h_def(k,m) = &
3824	pavement_subsurface_pars_1(k,pavement_type)
3825	surf_lsm_v(l)%rho_c_total_def(k,m) = &
3826	pavement_subsurface_pars_2(k,pavement_type)
3827	ENDDO
3828	ELSE
3829	surf_lsm_v(l)%lambda_h_def(:,m) = pavement_heat_conduct
3830	surf_lsm_v(l)%rho_c_total_def(:,m) = pavement_heat_capacity
3831	ENDIF
3832	ENDIF
3833	ENDDO
3834	ENDDO
3835	!
3836	!-- Level 2 initialization of pavement type surfaces via pavement_type read
3837	!-- from file. Pavement surfaces are initialized for each (y,x)-grid point
3838	!-- individually.
3839	IF ( pavement_type_f%from_file ) THEN
3840	!
3841	!-- Horizontal surfaces
3842	DO m = 1, surf_lsm_h%ns
3843	i = surf_lsm_h%i(m)
3844	j = surf_lsm_h%j(m)
3845
3846	st = pavement_type_f%var(j,i)
3847	IF ( st /= pavement_type_f%fill .AND. st /= 0 ) THEN
3848	!
3849	!-- Determine deepmost index of pavement layer
3850	DO k = nzb_soil, nzt_soil
3851	IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp &
3852	.OR. pavement_subsurface_pars_2(k,st) == 9999999.9_wp) &
3853	THEN
3854	surf_lsm_h%nzt_pavement(m) = k-1
3855	EXIT
3856	ENDIF
3857	ENDDO
3858
3859	surf_lsm_h%z0(m) = pavement_pars(ind_p_z0,st)
3860	surf_lsm_h%z0h(m) = pavement_pars(ind_p_z0h,st)
3861	surf_lsm_h%z0q(m) = pavement_pars(ind_p_z0h,st)
3862
3863	surf_lsm_h%lambda_surface_s(m) = &
3864	pavement_subsurface_pars_1(0,st) &
3865	* ddz_soil(nzb_soil) &
3866	* 2.0_wp
3867	surf_lsm_h%lambda_surface_u(m) = &
3868	pavement_subsurface_pars_1(0,st) &
3869	* ddz_soil(nzb_soil) &
3870	* 2.0_wp
3871	surf_lsm_h%c_surface(m) = &
3872	pavement_subsurface_pars_2(0,st)&
3873	* dz_soil(nzb_soil) &
3874	* 0.25_wp
3875	surf_lsm_h%albedo_type(ind_pav_green,m) = INT( pavement_pars(ind_p_at,st) )
3876	surf_lsm_h%emissivity(ind_pav_green,m) = pavement_pars(ind_p_emis,st)
3877
3878	surf_lsm_h%pavement_type(m) = st
3879	surf_lsm_h%pavement_type_name(m) = pavement_type_name(st)
3880
3881	DO k = nzb_soil, surf_lsm_h%nzt_pavement(m)
3882	surf_lsm_h%lambda_h_def(k,m) = &
3883	pavement_subsurface_pars_1(k,pavement_type)
3884	surf_lsm_h%rho_c_total_def(k,m) = &
3885	pavement_subsurface_pars_2(k,pavement_type)
3886	ENDDO
3887	ENDIF
3888	ENDDO
3889	!
3890	!-- Vertical surfaces
3891	DO l = 0, 3
3892	DO m = 1, surf_lsm_v(l)%ns
3893	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
3894	surf_lsm_v(l)%building_covered(m) )
3895	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
3896	surf_lsm_v(l)%building_covered(m) )
3897
3898	st = pavement_type_f%var(j,i)
3899	IF ( st /= pavement_type_f%fill .AND. st /= 0 ) THEN
3900	!
3901	!-- Determine deepmost index of pavement layer
3902	DO k = nzb_soil, nzt_soil
3903	IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp &
3904	.OR. pavement_subsurface_pars_2(k,st) == 9999999.9_wp) &
3905	THEN
3906	surf_lsm_v(l)%nzt_pavement(m) = k-1
3907	EXIT
3908	ENDIF
3909	ENDDO
3910
3911	surf_lsm_v(l)%z0(m) = pavement_pars(ind_p_z0,st)
3912	surf_lsm_v(l)%z0h(m) = pavement_pars(ind_p_z0h,st)
3913	surf_lsm_v(l)%z0q(m) = pavement_pars(ind_p_z0h,st)
3914
3915	surf_lsm_v(l)%lambda_surface_s(m) = &
3916	pavement_subsurface_pars_1(0,st) &
3917	* ddz_soil(nzb_soil) &
3918	* 2.0_wp
3919	surf_lsm_v(l)%lambda_surface_u(m) = &
3920	pavement_subsurface_pars_1(0,st) &
3921	* ddz_soil(nzb_soil) &
3922	* 2.0_wp
3923
3924	surf_lsm_v(l)%c_surface(m) = &
3925	pavement_subsurface_pars_2(0,st) &
3926	* dz_soil(nzb_soil) &
3927	* 0.25_wp
3928	surf_lsm_v(l)%albedo_type(ind_pav_green,m) = &
3929	INT( pavement_pars(ind_p_at,st) )
3930	surf_lsm_v(l)%emissivity(ind_pav_green,m) = &
3931	pavement_pars(ind_p_emis,st)
3932
3933	surf_lsm_v(l)%pavement_type(m) = st
3934	surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(st)
3935
3936	DO k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m)
3937	surf_lsm_v(l)%lambda_h_def(k,m) = &
3938	pavement_subsurface_pars_1(k,pavement_type)
3939	surf_lsm_v(l)%rho_c_total_def(k,m) = &
3940	pavement_subsurface_pars_2(k,pavement_type)
3941	ENDDO
3942	ENDIF
3943	ENDDO
3944	ENDDO
3945	ENDIF
3946	!
3947	!-- Level 3, initialization of pavement parameters at single (x,y)
3948	!-- position via pavement_pars read from file.
3949	IF ( pavement_pars_f%from_file ) THEN
3950	!
3951	!-- Horizontal surfaces
3952	DO m = 1, surf_lsm_h%ns
3953	i = surf_lsm_h%i(m)
3954	j = surf_lsm_h%j(m)
3955	!
3956	!-- If surface element is not a pavement surface and any value in
3957	!-- pavement_pars is given, neglect this information and give an
3958	!-- informative message that this value will not be used.
3959	IF ( .NOT. surf_lsm_h%pavement_surface(m) .AND. &
3960	ANY( pavement_pars_f%pars_xy(:,j,i) /= &
3961	pavement_pars_f%fill ) ) THEN
3962	WRITE( message_string, * ) &
3963	'surface element at grid point (j,i) = (', &
3964	j, i, ') is not a pavement surface, ', &
3965	'so that information given in ', &
3966	'pavement_pars at this point is neglected.'
3967	CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 )
3968	ELSE
3969	IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= &
3970	pavement_pars_f%fill ) &
3971	surf_lsm_h%z0(m) = pavement_pars_f%pars_xy(ind_p_z0,j,i)
3972	IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= &
3973	pavement_pars_f%fill ) THEN
3974	surf_lsm_h%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
3975	surf_lsm_h%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
3976	ENDIF
3977	IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) &
3978	/= pavement_subsurface_pars_f%fill ) THEN
3979	surf_lsm_h%lambda_surface_s(m) = &
3980	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)&
3981	* ddz_soil(nzb_soil) &
3982	* 2.0_wp
3983	surf_lsm_h%lambda_surface_u(m) = &
3984	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)&
3985	* ddz_soil(nzb_soil) &
3986	* 2.0_wp
3987	ENDIF
3988	IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) /= &
3989	pavement_subsurface_pars_f%fill ) THEN
3990	surf_lsm_h%c_surface(m) = &
3991	pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) &
3992	* dz_soil(nzb_soil) &
3993	* 0.25_wp
3994	ENDIF
3995	IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= &
3996	pavement_pars_f%fill ) &
3997	surf_lsm_h%albedo_type(ind_pav_green,m) = &
3998	INT( pavement_pars_f%pars_xy(ind_p_at,j,i) )
3999	IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= &
4000	pavement_pars_f%fill ) &
4001	surf_lsm_h%emissivity(ind_pav_green,m) = &
4002	pavement_pars_f%pars_xy(ind_p_emis,j,i)
4003	ENDIF
4004
4005	ENDDO
4006	!
4007	!-- Vertical surfaces
4008	DO l = 0, 3
4009	DO m = 1, surf_lsm_v(l)%ns
4010	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
4011	surf_lsm_v(l)%building_covered(m) )
4012	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
4013	surf_lsm_v(l)%building_covered(m) )
4014	!
4015	!-- If surface element is not a pavement surface and any value in
4016	!-- pavement_pars is given, neglect this information and give an
4017	!-- informative message that this value will not be used.
4018	IF ( .NOT. surf_lsm_v(l)%pavement_surface(m) .AND. &
4019	ANY( pavement_pars_f%pars_xy(:,j,i) /= &
4020	pavement_pars_f%fill ) ) THEN
4021	WRITE( message_string, * ) &
4022	'surface element at grid point (j,i) = (', &
4023	j, i, ') is not a pavement surface, ', &
4024	'so that information given in ', &
4025	'pavement_pars at this point is neglected.'
4026	CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 )
4027	ELSE
4028
4029	IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= &
4030	pavement_pars_f%fill ) &
4031	surf_lsm_v(l)%z0(m) = pavement_pars_f%pars_xy(ind_p_z0,j,i)
4032	IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= &
4033	pavement_pars_f%fill ) THEN
4034	surf_lsm_v(l)%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
4035	surf_lsm_v(l)%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
4036	ENDIF
4037	IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)&
4038	/= pavement_subsurface_pars_f%fill ) THEN
4039	surf_lsm_v(l)%lambda_surface_s(m) = &
4040	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)&
4041	* ddz_soil(nzb_soil) &
4042	* 2.0_wp
4043	surf_lsm_v(l)%lambda_surface_u(m) = &
4044	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)&
4045	* ddz_soil(nzb_soil) &
4046	* 2.0_wp
4047	ENDIF
4048	IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) &
4049	/= pavement_subsurface_pars_f%fill ) THEN
4050	surf_lsm_v(l)%c_surface(m) = &
4051	pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)&
4052	* dz_soil(nzb_soil) &
4053	* 0.25_wp
4054	ENDIF
4055	IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= &
4056	pavement_pars_f%fill ) &
4057	surf_lsm_v(l)%albedo_type(ind_pav_green,m) = &
4058	INT( pavement_pars_f%pars_xy(ind_p_at,j,i) )
4059
4060	IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= &
4061	pavement_pars_f%fill ) &
4062	surf_lsm_v(l)%emissivity(ind_pav_green,m) = &
4063	pavement_pars_f%pars_xy(ind_p_emis,j,i)
4064	ENDIF
4065	ENDDO
4066	ENDDO
4067	ENDIF
4068	!
4069	!-- Moreover, for grid points which are flagged with pavement-type 0 or whre
4070	!-- pavement_subsurface_pars_f is provided, soil heat conductivity and
4071	!-- capacity are initialized with parameters given in
4072	!-- pavement_subsurface_pars read from file.
4073	IF ( pavement_subsurface_pars_f%from_file ) THEN
4074	!
4075	!-- Set pavement depth to nzt_soil. Please note, this is just a
4076	!-- workaround at the moment.
4077	DO m = 1, surf_lsm_h%ns
4078	IF ( surf_lsm_h%pavement_surface(m) ) THEN
4079
4080	i = surf_lsm_h%i(m)
4081	j = surf_lsm_h%j(m)
4082
4083	surf_lsm_h%nzt_pavement(m) = nzt_soil
4084
4085	DO k = nzb_soil, nzt_soil
4086	surf_lsm_h%lambda_h_def(k,m) = &
4087	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
4088	surf_lsm_h%rho_c_total_def(k,m) = &
4089	pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
4090	ENDDO
4091
4092	ENDIF
4093	ENDDO
4094	DO l = 0, 3
4095	DO m = 1, surf_lsm_v(l)%ns
4096	IF ( surf_lsm_v(l)%pavement_surface(m) ) THEN
4097
4098	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
4099	surf_lsm_v(l)%building_covered(m) )
4100	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
4101	surf_lsm_v(l)%building_covered(m) )
4102
4103	surf_lsm_v(l)%nzt_pavement(m) = nzt_soil
4104
4105	DO k = nzb_soil, nzt_soil
4106	surf_lsm_v(l)%lambda_h_def(k,m) = &
4107	pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
4108	surf_lsm_v(l)%rho_c_total_def(k,m) = &
4109	pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
4110	ENDDO
4111
4112	ENDIF
4113	ENDDO
4114	ENDDO
4115	ENDIF
4116
4117	!
4118	!-- Initial run actions
4119	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
4120	!
4121	!-- First, initialize soil temperature and moisture.
4122	!-- According to the initialization for surface and soil parameters,
4123	!-- initialize soil moisture and temperature via a level approach. This
4124	!-- is to assure that all surface elements are initialized, even if
4125	!-- data provided from input file contains fill values at some locations.
4126	!-- Level 1, initialization via profiles given in parameter file
4127	DO m = 1, surf_lsm_h%ns
4128	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4129	surf_lsm_h%pavement_surface(m) ) THEN
4130	DO k = nzb_soil, nzt_soil
4131	t_soil_h%var_2d(k,m) = soil_temperature(k)
4132	m_soil_h%var_2d(k,m) = soil_moisture(k)
4133	ENDDO
4134	t_soil_h%var_2d(nzt_soil+1,m) = deep_soil_temperature
4135	ENDIF
4136	ENDDO
4137	DO l = 0, 3
4138	DO m = 1, surf_lsm_v(l)%ns
4139	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4140	surf_lsm_v(l)%pavement_surface(m) ) THEN
4141	DO k = nzb_soil, nzt_soil
4142	t_soil_v(l)%var_2d(k,m) = soil_temperature(k)
4143	m_soil_v(l)%var_2d(k,m) = soil_moisture(k)
4144	ENDDO
4145	t_soil_v(l)%var_2d(nzt_soil+1,m) = deep_soil_temperature
4146	ENDIF
4147	ENDDO
4148	ENDDO
4149	!
4150	!-- Level 2 initialization of the soil, read soil properties from
4151	!-- dynamic input file.
4152	IF ( input_pids_dynamic ) THEN
4153	!
4154	!-- CPU measurement
4155	CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' )
4156	#if defined ( __netcdf )
4157	!
4158	!-- Open file in read-only mode
4159	CALL open_read_file( TRIM( input_file_dynamic ) // &
4160	TRIM( coupling_char ), pids_id )
4161	!
4162	!-- Inquire all variable names
4163	CALL inquire_num_variables( pids_id, num_var_pids )
4164	!
4165	!-- Allocate memory to store variable names.
4166	ALLOCATE( vars_pids(1:num_var_pids) )
4167	CALL inquire_variable_names( pids_id, vars_pids )
4168	!
4169	!-- Read vertical dimension for soil depth.
4170	IF ( check_existence( vars_pids, 'zsoil' ) ) &
4171	CALL get_dimension_length( pids_id, init_3d%nzs, 'zsoil' )
4172	!
4173	!-- Read also the horizontal dimensions required for soil initialization.
4174	!-- Please note, in case of non-nested runs or in case of root domain,
4175	!-- these data is already available, but will be read again for the sake
4176	!-- of clearness.
4177	CALL get_dimension_length( pids_id, init_3d%nx, 'x' )
4178	CALL get_dimension_length( pids_id, init_3d%ny, 'y' )
4179	!
4180	!-- Check for correct horizontal and vertical dimension. Please note,
4181	!-- in case of non-nested runs or in case of root domain, these checks
4182	!-- are already performed
4183	IF ( init_3d%nx-1 /= nx .OR. init_3d%ny-1 /= ny ) THEN
4184	message_string = 'Number of horizontal grid points in '// &
4185	'dynamic input file does not match ' // &
4186	'the number of numeric grid points.'
4187	CALL message( 'lsm_init', 'PA0543', 1, 2, 0, 6, 0 )
4188	ENDIF
4189	!
4190	!-- Read vertical dimensions. Later, these are required for eventual
4191	!-- inter- and extrapolations of the initialization data.
4192	IF ( check_existence( vars_pids, 'zsoil' ) ) THEN
4193	ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
4194	CALL get_variable( pids_id, 'zsoil', init_3d%z_soil )
4195	ENDIF
4196	!
4197	!-- Read initial data for soil moisture
4198	IF ( check_existence( vars_pids, 'init_soil_m' ) ) THEN
4199	!
4200	!-- Read attributes for the fill value and level-of-detail
4201	CALL get_attribute( pids_id, char_fill, &
4202	init_3d%fill_msoil, &
4203	.FALSE., 'init_soil_m' )
4204	CALL get_attribute( pids_id, char_lod, &
4205	init_3d%lod_msoil, &
4206	.FALSE., 'init_soil_m' )
4207	!
4208	!-- level-of-detail 1 - read initialization profile
4209	IF ( init_3d%lod_msoil == 1 ) THEN
4210	ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
4211
4212	CALL get_variable( pids_id, 'init_soil_m', &
4213	init_3d%msoil_1d(0:init_3d%nzs-1) )
4214	!
4215	!-- level-of-detail 2 - read 3D initialization data
4216	ELSEIF ( init_3d%lod_msoil == 2 ) THEN
4217	ALLOCATE ( init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
4218
4219	CALL get_variable( pids_id, 'init_soil_m', &
4220	init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),&
4221	nxl, nxr, nys, nyn, 0, init_3d%nzs-1 )
4222
4223	ENDIF
4224	init_3d%from_file_msoil = .TRUE.
4225	ENDIF
4226	!
4227	!-- Read soil temperature
4228	IF ( check_existence( vars_pids, 'init_soil_t' ) ) THEN
4229	!
4230	!-- Read attributes for the fill value and level-of-detail
4231	CALL get_attribute( pids_id, char_fill, &
4232	init_3d%fill_tsoil, &
4233	.FALSE., 'init_soil_t' )
4234	CALL get_attribute( pids_id, char_lod, &
4235	init_3d%lod_tsoil, &
4236	.FALSE., 'init_soil_t' )
4237	!
4238	!-- level-of-detail 1 - read initialization profile
4239	IF ( init_3d%lod_tsoil == 1 ) THEN
4240	ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
4241
4242	CALL get_variable( pids_id, 'init_soil_t', &
4243	init_3d%tsoil_1d(0:init_3d%nzs-1) )
4244
4245	!
4246	!-- level-of-detail 2 - read 3D initialization data
4247	ELSEIF ( init_3d%lod_tsoil == 2 ) THEN
4248	ALLOCATE ( init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
4249
4250	CALL get_variable( pids_id, 'init_soil_t', &
4251	init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),&
4252	nxl, nxr, nys, nyn, 0, init_3d%nzs-1 )
4253	ENDIF
4254	init_3d%from_file_tsoil = .TRUE.
4255	ENDIF
4256	!
4257	!-- Close the input file and deallocate temporary arrays
4258	DEALLOCATE( vars_pids )
4259
4260	CALL close_input_file( pids_id )
4261	#endif
4262	!
4263	!-- End of CPU measurement
4264	CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' )
4265	ENDIF
4266	!
4267	!-- In case no dynamic input is available for a child domain but the
4268	!-- parent is initialized with dynamic input file, the different soil
4269	!-- states can lead to significant discrepancies in the atmospheric
4270	!-- surface forcing. For this reason, the child domain is initialized with
4271	!-- domain-averaged soil profiles from the root domain, even if
4272	!-- no initialization with inifor is set. Note, as long as a dynamic
4273	!-- input file with soil information is available for the child domain,
4274	!-- the input file information will be used.
4275	IF ( nested_run ) THEN
4276	#if defined( __parallel )
4277	!
4278	!-- In case of a nested run, first average the soil profiles in the
4279	!-- root domain.
4280	IF ( pmc_is_rootmodel() ) THEN
4281	!
4282	!-- Child domains will be only initialized with horizontally
4283	!-- averaged soil profiles in parent domain (for sake of simplicity).
4284	!-- If required, average soil data on root parent domain before the
4285	!-- soil profiles are distributed onto the child domains.
4286	!-- Start with soil moisture.
4287	IF ( init_3d%from_file_msoil .AND. init_3d%lod_msoil == 2 ) &
4288	THEN
4289	ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )
4290	DO k = 0, init_3d%nzs-1
4291	pr_soil_init(k) = SUM( init_3d%msoil_3d(k,nys:nyn,nxl:nxr) )
4292	ENDDO
4293	!
4294	!-- Allocate 1D array for soil-moisture profile (will not be
4295	!-- allocated in lod==2 case).
4296	ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
4297	init_3d%msoil_1d = 0.0_wp
4298	CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%msoil_1d(0), &
4299	SIZE(pr_soil_init), &
4300	MPI_REAL, MPI_SUM, comm2d, ierr )
4301
4302	init_3d%msoil_1d = init_3d%msoil_1d / &
4303	REAL( ( nx + 1 ) * ( ny + 1), KIND=wp )
4304	DEALLOCATE( pr_soil_init )
4305	ENDIF
4306	!
4307	!-- Proceed with soil temperature.
4308	IF ( init_3d%from_file_tsoil .AND. init_3d%lod_tsoil == 2 ) &
4309	THEN
4310	ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )
4311
4312	DO k = 0, init_3d%nzs-1
4313	pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr) )
4314	ENDDO
4315	!
4316	!-- Allocate 1D array for soil-temperature profile (will not be
4317	!-- allocated in lod==2 case).
4318	ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
4319	init_3d%tsoil_1d = 0.0_wp
4320	CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%tsoil_1d(0), &
4321	SIZE(pr_soil_init), &
4322	MPI_REAL, MPI_SUM, comm2d, ierr )
4323	init_3d%tsoil_1d = init_3d%tsoil_1d / &
4324	REAL( ( nx + 1 ) * ( ny + 1), KIND=wp )
4325	DEALLOCATE( pr_soil_init )
4326
4327	ENDIF
4328	ENDIF
4329	!
4330	!-- Broadcast number of soil layers in root model to all childs.
4331	!-- Note, only process 0 in COMM_WORLD is sending.
4332	IF ( pmc_is_rootmodel() ) nzs_root = init_3d%nzs
4333
4334	CALL MPI_BCAST( nzs_root, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
4335	!
4336	!-- Allocate dummy arrays for soil moisture and temperature profiles
4337	!-- on all domains.
4338	ALLOCATE( z_soil_root(1:nzs_root) )
4339	ALLOCATE( m_soil_root(0:nzs_root-1) )
4340	ALLOCATE( t_soil_root(0:nzs_root-1) )
4341	!
4342	!-- Distribute the mean soil profiles to all child domains.
4343	IF ( pmc_is_rootmodel() ) THEN
4344	z_soil_root = init_3d%z_soil
4345	m_soil_root = init_3d%msoil_1d
4346	t_soil_root = init_3d%tsoil_1d
4347	ENDIF
4348
4349	CALL MPI_BCAST( z_soil_root, SIZE( z_soil_root ), &
4350	MPI_REAL, 0, MPI_COMM_WORLD, ierr )
4351	CALL MPI_BCAST( m_soil_root, SIZE( m_soil_root ), &
4352	MPI_REAL, 0, MPI_COMM_WORLD, ierr )
4353	CALL MPI_BCAST( t_soil_root, SIZE( t_soil_root ), &
4354	MPI_REAL, 0, MPI_COMM_WORLD, ierr )
4355	!
4356	!-- In the following, the child domains decide whether they take
4357	!-- the information from the root domain or not.
4358	IF ( .NOT. pmc_is_rootmodel() ) THEN
4359	!
4360	!-- If soil moisture or temperature isn't in dynamic input file for
4361	!-- the child, take the information provided from the root model.
4362	!-- Start with z-dimension
4363	IF ( .NOT. init_3d%from_file_msoil .OR. &
4364	.NOT. init_3d%from_file_msoil ) THEN
4365	init_3d%nzs = nzs_root
4366	ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
4367	init_3d%z_soil(1:init_3d%nzs) = z_soil_root
4368	ENDIF
4369	!
4370	!-- Take soil moisture. Note, control flags from_file... and LoD
4371	!-- need to be set.
4372	IF ( .NOT. init_3d%from_file_msoil ) THEN
4373	ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) )
4374	init_3d%lod_msoil = 1
4375	init_3d%from_file_msoil = .TRUE.
4376
4377	init_3d%msoil_1d = m_soil_root
4378	ENDIF
4379	!
4380	!-- Take soil temperature. Note, control flags from_file... and LoD
4381	!-- need to be set.
4382	IF ( .NOT. init_3d%from_file_tsoil ) THEN
4383	ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
4384	init_3d%lod_tsoil = 1
4385	init_3d%from_file_tsoil = .TRUE.
4386
4387	init_3d%tsoil_1d = t_soil_root
4388	ENDIF
4389	ENDIF
4390
4391	DEALLOCATE( z_soil_root )
4392	DEALLOCATE( m_soil_root )
4393	DEALLOCATE( t_soil_root )
4394	ENDIF
4395	#endif
4396	!
4397	!-- Proceed with Level 2 initialization.
4398	IF ( init_3d%from_file_msoil ) THEN
4399
4400	IF ( init_3d%lod_msoil == 1 ) THEN
4401	DO m = 1, surf_lsm_h%ns
4402	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4403	surf_lsm_h%pavement_surface(m) ) THEN
4404
4405	CALL interpolate_soil_profile( &
4406	m_soil_h%var_2d(nzb_soil:nzt_soil,m), &
4407	init_3d%msoil_1d(:), &
4408	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4409	nzb_soil, nzt_soil, &
4410	nzb_soil, init_3d%nzs-1 )
4411	ENDIF
4412	ENDDO
4413	DO l = 0, 3
4414	DO m = 1, surf_lsm_v(l)%ns
4415	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4416	surf_lsm_v(l)%pavement_surface(m) ) THEN
4417	CALL interpolate_soil_profile( &
4418	m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
4419	init_3d%msoil_1d(:), &
4420	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4421	nzb_soil, nzt_soil, &
4422	nzb_soil, init_3d%nzs-1 )
4423	ENDIF
4424	ENDDO
4425	ENDDO
4426	ELSE
4427
4428	DO m = 1, surf_lsm_h%ns
4429	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4430	surf_lsm_h%pavement_surface(m) ) THEN
4431	i = surf_lsm_h%i(m)
4432	j = surf_lsm_h%j(m)
4433
4434	IF ( init_3d%msoil_3d(0,j,i) /= init_3d%fill_msoil ) &
4435	CALL interpolate_soil_profile( &
4436	m_soil_h%var_2d(nzb_soil:nzt_soil,m), &
4437	init_3d%msoil_3d(:,j,i), &
4438	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4439	nzb_soil, nzt_soil, &
4440	nzb_soil, init_3d%nzs-1 )
4441	ENDIF
4442	ENDDO
4443	DO l = 0, 3
4444	DO m = 1, surf_lsm_v(l)%ns
4445	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4446	surf_lsm_v(l)%pavement_surface(m) ) THEN
4447	!
4448	!-- Note, in contrast to the static input data the dynamic
4449	!-- input do not need to be checked whether a grid point
4450	!-- is building covered. This is because soil data in the
4451	!-- dynamic input is provided for the whole domain.
4452	i = surf_lsm_v(l)%i(m)
4453	j = surf_lsm_v(l)%j(m)
4454
4455	IF ( init_3d%msoil_3d(0,j,i) /= init_3d%fill_msoil ) &
4456	CALL interpolate_soil_profile( &
4457	m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
4458	init_3d%msoil_3d(:,j,i), &
4459	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4460	nzb_soil, nzt_soil, &
4461	nzb_soil, init_3d%nzs-1 )
4462	ENDIF
4463	ENDDO
4464	ENDDO
4465	ENDIF
4466	ENDIF
4467	!
4468	!-- Soil temperature
4469	IF ( init_3d%from_file_tsoil ) THEN
4470
4471	IF ( init_3d%lod_tsoil == 1 ) THEN ! change to 1 if provided correctly by INIFOR
4472	DO m = 1, surf_lsm_h%ns
4473	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4474	surf_lsm_h%pavement_surface(m) ) THEN
4475	CALL interpolate_soil_profile( &
4476	t_soil_h%var_2d(nzb_soil:nzt_soil,m), &
4477	init_3d%tsoil_1d(:), &
4478	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4479	nzb_soil, nzt_soil, &
4480	nzb_soil, init_3d%nzs-1 )
4481	!
4482	!-- Set boundary condition, i.e. deep soil temperature
4483	t_soil_h%var_2d(nzt_soil+1,m) = t_soil_h%var_2d(nzt_soil,m)
4484	ENDIF
4485	ENDDO
4486	DO l = 0, 3
4487	DO m = 1, surf_lsm_v(l)%ns
4488	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4489	surf_lsm_v(l)%pavement_surface(m) ) THEN
4490	CALL interpolate_soil_profile( &
4491	t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
4492	init_3d%tsoil_1d(:), &
4493	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4494	nzb_soil, nzt_soil, &
4495	nzb_soil, init_3d%nzs-1 )
4496	!
4497	!-- Set boundary condition, i.e. deep soil temperature
4498	t_soil_v(l)%var_2d(nzt_soil+1,m) = &
4499	t_soil_v(l)%var_2d(nzt_soil,m)
4500	ENDIF
4501	ENDDO
4502	ENDDO
4503	ELSE
4504
4505	DO m = 1, surf_lsm_h%ns
4506	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4507	surf_lsm_h%pavement_surface(m) ) THEN
4508	i = surf_lsm_h%i(m)
4509	j = surf_lsm_h%j(m)
4510
4511	IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil ) &
4512	CALL interpolate_soil_profile( &
4513	t_soil_h%var_2d(nzb_soil:nzt_soil,m), &
4514	init_3d%tsoil_3d(:,j,i), &
4515	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4516	nzb_soil, nzt_soil, &
4517	nzb_soil, init_3d%nzs-1 )
4518	!
4519	!-- Set boundary condition, i.e. deep soil temperature
4520	t_soil_h%var_2d(nzt_soil+1,m) = t_soil_h%var_2d(nzt_soil,m)
4521	ENDIF
4522	ENDDO
4523	DO l = 0, 3
4524	DO m = 1, surf_lsm_v(l)%ns
4525	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4526	surf_lsm_v(l)%pavement_surface(m) ) THEN
4527	!
4528	!-- Note, in contrast to the static input data the dynamic
4529	!-- input do not need to be checked whether a grid point
4530	!-- is building covered. This is because soil data in the
4531	!-- dynamic input is provided for the whole domain.
4532	i = surf_lsm_v(l)%i(m)
4533	j = surf_lsm_v(l)%j(m)
4534
4535	IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil ) &
4536	CALL interpolate_soil_profile( &
4537	t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
4538	init_3d%tsoil_3d(:,j,i), &
4539	zs(nzb_soil:nzt_soil), init_3d%z_soil, &
4540	nzb_soil, nzt_soil, &
4541	nzb_soil, init_3d%nzs-1 )
4542	!
4543	!-- Set boundary condition, i.e. deep soil temperature
4544	t_soil_v(l)%var_2d(nzt_soil+1,m) = &
4545	t_soil_v(l)%var_2d(nzt_soil,m)
4546	ENDIF
4547	ENDDO
4548	ENDDO
4549	ENDIF
4550	ENDIF
4551	!
4552	!-- After soil moisture and temperature are finally initialized, check
4553	!-- if soil moisture is higher than its saturation value. If this would
4554	!-- be the case, the soil model parametrization will produce floating
4555	!-- point errors. Hence, limit the soil moisture to its saturation value
4556	!-- and give a warning.
4557	DO m = 1, surf_lsm_h%ns
4558	IF ( surf_lsm_h%vegetation_surface(m) .OR. &
4559	surf_lsm_h%pavement_surface(m) ) THEN
4560	DO k = nzb_soil, nzt_soil
4561	IF ( m_soil_h%var_2d(k,m) > surf_lsm_h%m_sat(k,m) ) THEN
4562	m_soil_h%var_2d(k,m) = surf_lsm_h%m_sat(k,m)
4563	WRITE( message_string, * ) 'soil moisture is higher '// &
4564	'than its saturation value at (k,j,i) ', k, &
4565	surf_lsm_h%i(m), surf_lsm_h%j(m), ' and is ' // &
4566	'thus limited to this value to maintain stability.'
4567	CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 )
4568	ENDIF
4569	ENDDO
4570	ENDIF
4571	ENDDO
4572	DO l = 0, 3
4573	DO m = 1, surf_lsm_v(l)%ns
4574	IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. &
4575	surf_lsm_v(l)%pavement_surface(m) ) THEN
4576	DO k = nzb_soil, nzt_soil
4577	IF ( m_soil_v(l)%var_2d(k,m) > surf_lsm_v(l)%m_sat(k,m) )&
4578	THEN
4579	m_soil_v(l)%var_2d(k,m) = surf_lsm_v(l)%m_sat(k,m)
4580	WRITE( message_string, * ) &
4581	'soil moisture is higher '// &
4582	'than its saturation value at (k,j,i) ', k, &
4583	surf_lsm_v(l)%i(m), surf_lsm_v(l)%j(m), &
4584	' and is ' // &
4585	'thus limited to this value to maintain stability.'
4586	CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 )
4587	ENDIF
4588	ENDDO
4589	ENDIF
4590	ENDDO
4591	ENDDO
4592
4593	!
4594	!-- Further initialization
4595	DO m = 1, surf_lsm_h%ns
4596
4597	i = surf_lsm_h%i(m)
4598	j = surf_lsm_h%j(m)
4599	k = surf_lsm_h%k(m)
4600	!
4601	!-- Initialize surface temperature with soil temperature in the uppermost
4602	!-- uppermost layer
4603	t_surface_h%var_1d(m) = t_soil_h%var_2d(nzb_soil,m)
4604	surf_lsm_h%pt_surface(m) = t_soil_h%var_2d(nzb_soil,m) / exner(nzb)
4605
4606	IF ( bulk_cloud_model .OR. cloud_droplets ) THEN
4607	surf_lsm_h%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
4608	ELSE
4609	surf_lsm_h%pt1(m) = pt(k,j,i)
4610	ENDIF
4611	!
4612	!-- Assure that r_a cannot be zero at model start
4613	IF ( surf_lsm_h%pt1(m) == surf_lsm_h%pt_surface(m) ) &
4614	surf_lsm_h%pt1(m) = surf_lsm_h%pt1(m) + 1.0E-20_wp
4615
4616	surf_lsm_h%us(m) = 0.1_wp
4617	surf_lsm_h%ts(m) = ( surf_lsm_h%pt1(m) - surf_lsm_h%pt_surface(m) )&
4618	/ surf_lsm_h%r_a(m)
4619	surf_lsm_h%shf(m) = - surf_lsm_h%us(m) * surf_lsm_h%ts(m) &
4620	* rho_surface
4621	ENDDO
4622	!
4623	!-- Vertical surfaces
4624	DO l = 0, 3
4625	DO m = 1, surf_lsm_v(l)%ns
4626	i = surf_lsm_v(l)%i(m)
4627	j = surf_lsm_v(l)%j(m)
4628	k = surf_lsm_v(l)%k(m)
4629	!
4630	!-- Initialize surface temperature with soil temperature in the uppermost
4631	!-- uppermost layer
4632	t_surface_v(l)%var_1d(m) = t_soil_v(l)%var_2d(nzb_soil,m)
4633	surf_lsm_v(l)%pt_surface(m) = t_soil_v(l)%var_2d(nzb_soil,m) / exner(nzb)
4634
4635	IF ( bulk_cloud_model .OR. cloud_droplets ) THEN
4636	surf_lsm_v(l)%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
4637	ELSE
4638	surf_lsm_v(l)%pt1(m) = pt(k,j,i)
4639	ENDIF
4640
4641	!
4642	!-- Assure that r_a cannot be zero at model start
4643	IF ( surf_lsm_v(l)%pt1(m) == surf_lsm_v(l)%pt_surface(m) ) &
4644	surf_lsm_v(l)%pt1(m) = surf_lsm_v(l)%pt1(m) + 1.0E-20_wp
4645	!
4646	!-- Set artifical values for ts and us so that r_a has its initial value
4647	!-- for the first time step. Only for interior core domain, not for ghost points
4648	surf_lsm_v(l)%us(m) = 0.1_wp
4649	surf_lsm_v(l)%ts(m) = ( surf_lsm_v(l)%pt1(m) - surf_lsm_v(l)%pt_surface(m) ) /&
4650	surf_lsm_v(l)%r_a(m)
4651	surf_lsm_v(l)%shf(m) = - surf_lsm_v(l)%us(m) * &
4652	surf_lsm_v(l)%ts(m) * rho_surface
4653
4654	ENDDO
4655	ENDDO
4656	ENDIF
4657	!
4658	!-- Level 1 initialization of root distribution - provided by the user via
4659	!-- via namelist.
4660	DO m = 1, surf_lsm_h%ns
4661	DO k = nzb_soil, nzt_soil
4662	surf_lsm_h%root_fr(k,m) = root_fraction(k)
4663	ENDDO
4664	ENDDO
4665
4666	DO l = 0, 3
4667	DO m = 1, surf_lsm_v(l)%ns
4668	DO k = nzb_soil, nzt_soil
4669	surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
4670	ENDDO
4671	ENDDO
4672	ENDDO
4673
4674	!
4675	!-- Level 2 initialization of root distribution.
4676	!-- When no root distribution is given by the user, use look-up table to prescribe
4677	!-- the root fraction in the individual soil layers.
4678	IF ( ALL( root_fraction == 9999999.9_wp ) ) THEN
4679	!
4680	!-- First, calculate the index bounds for integration
4681	n_soil_layers_total = nzt_soil - nzb_soil + 6
4682	ALLOCATE ( bound(0:n_soil_layers_total) )
4683	ALLOCATE ( bound_root_fr(0:n_soil_layers_total) )
4684
4685	kn = 0
4686	ko = 0
4687	bound(0) = 0.0_wp
4688	DO k = 1, n_soil_layers_total-1
4689	IF ( zs_layer(kn) <= zs_ref(ko) ) THEN
4690	bound(k) = zs_layer(kn)
4691	bound_root_fr(k) = ko
4692	kn = kn + 1
4693	IF ( kn > nzt_soil+1 ) THEN
4694	kn = nzt_soil
4695	ENDIF
4696	ELSE
4697	bound(k) = zs_ref(ko)
4698	bound_root_fr(k) = ko
4699	ko = ko + 1
4700	IF ( ko > 3 ) THEN
4701	ko = 3
4702	ENDIF
4703	ENDIF
4704
4705	ENDDO
4706
4707	!
4708	!-- Integrate over all soil layers based on the four-layer root fraction
4709	kzs = 1
4710	root_fraction = 0.0_wp
4711	DO k = 0, n_soil_layers_total-2
4712	kroot = bound_root_fr(k+1)
4713	root_fraction(kzs-1) = root_fraction(kzs-1) &
4714	+ root_distribution(kroot,vegetation_type) &
4715	/ dz_soil_ref(kroot) * ( bound(k+1) - bound(k) )
4716
4717	IF ( bound(k+1) == zs_layer(kzs-1) ) THEN
4718	kzs = kzs+1
4719	ENDIF
4720	ENDDO
4721
4722
4723	!
4724	!-- Normalize so that the sum of all fractions equals one
4725	root_fraction = root_fraction / SUM(root_fraction)
4726
4727	DEALLOCATE ( bound )
4728	DEALLOCATE ( bound_root_fr )
4729
4730	!
4731	!-- Map calculated root fractions
4732	DO m = 1, surf_lsm_h%ns
4733	DO k = nzb_soil, nzt_soil
4734	IF ( surf_lsm_h%pavement_surface(m) .AND. &
4735	k <= surf_lsm_h%nzt_pavement(m) ) THEN
4736	surf_lsm_h%root_fr(k,m) = 0.0_wp
4737	ELSE
4738	surf_lsm_h%root_fr(k,m) = root_fraction(k)
4739	ENDIF
4740
4741	ENDDO
4742	!
4743	!-- Normalize so that the sum = 1. Only relevant when the root
4744	!-- distribution was set to zero due to pavement at some layers.
4745	IF ( SUM( surf_lsm_h%root_fr(:,m) ) > 0.0_wp ) THEN
4746	DO k = nzb_soil, nzt_soil
4747	surf_lsm_h%root_fr(k,m) = surf_lsm_h%root_fr(k,m) &
4748	/ SUM( surf_lsm_h%root_fr(:,m) )
4749	ENDDO
4750	ENDIF
4751	ENDDO
4752	DO l = 0, 3
4753	DO m = 1, surf_lsm_v(l)%ns
4754	DO k = nzb_soil, nzt_soil
4755	IF ( surf_lsm_v(l)%pavement_surface(m) .AND. &
4756	k <= surf_lsm_v(l)%nzt_pavement(m) ) THEN
4757	surf_lsm_v(l)%root_fr(k,m) = 0.0_wp
4758	ELSE
4759	surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
4760	ENDIF
4761	ENDDO
4762	!
4763	!-- Normalize so that the sum = 1. Only relevant when the root
4764	!-- distribution was set to zero due to pavement at some layers.
4765	IF ( SUM( surf_lsm_v(l)%root_fr(:,m) ) > 0.0_wp ) THEN
4766	DO k = nzb_soil, nzt_soil
4767	surf_lsm_v(l)%root_fr(k,m) = surf_lsm_v(l)%root_fr(k,m) &
4768	/ SUM( surf_lsm_v(l)%root_fr(:,m) )
4769	ENDDO
4770	ENDIF
4771	ENDDO
4772	ENDDO
4773	ENDIF
4774	!
4775	!-- Level 3 initialization of root distribution.
4776	!-- Take value from file
4777	IF ( root_area_density_lsm_f%from_file ) THEN
4778	DO m = 1, surf_lsm_h%ns
4779	IF ( surf_lsm_h%vegetation_surface(m) ) THEN
4780	i = surf_lsm_h%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
4781	surf_lsm_v(l)%building_covered(m) )
4782	j = surf_lsm_h%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
4783	surf_lsm_v(l)%building_covered(m) )
4784	DO k = nzb_soil, nzt_soil
4785	surf_lsm_h%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i)
4786	ENDDO
4787
4788	ENDIF
4789	ENDDO
4790
4791	DO l = 0, 3
4792	DO m = 1, surf_lsm_v(l)%ns
4793	IF ( surf_lsm_v(l)%vegetation_surface(m) ) THEN
4794	i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, &
4795	surf_lsm_v(l)%building_covered(m) )
4796	j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, &
4797	surf_lsm_v(l)%building_covered(m) )
4798
4799	DO k = nzb_soil, nzt_soil
4800	surf_lsm_v(l)%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i)
4801	ENDDO
4802
4803	ENDIF
4804	ENDDO
4805	ENDDO
4806
4807	ENDIF
4808
4809	!
4810	!-- Possibly do user-defined actions (e.g. define heterogeneous land surface)
4811	CALL user_init_land_surface
4812
4813
4814	!
4815	!-- Calculate new roughness lengths (for water surfaces only, i.e. only
4816	!- horizontal surfaces)
4817	IF ( .NOT. constant_roughness ) CALL calc_z0_water_surface
4818
4819	t_soil_h_p = t_soil_h
4820	m_soil_h_p = m_soil_h
4821	m_liq_h_p = m_liq_h
4822	t_surface_h_p = t_surface_h
4823
4824	t_soil_v_p = t_soil_v
4825	m_soil_v_p = m_soil_v
4826	m_liq_v_p = m_liq_v
4827	t_surface_v_p = t_surface_v
4828
4829
4830
4831	!-- Store initial profiles of t_soil and m_soil (assuming they are
4832	!-- horizontally homogeneous on this PE)
4833	!-- DEACTIVATED FOR NOW - leads to error when number of locations with
4834	!-- soil model is zero on a PE.
4835	! hom(nzb_soil:nzt_soil,1,90,:) = SPREAD( t_soil_h%var_2d(nzb_soil:nzt_soil,1), &
4836	! 2, statistic_regions+1 )
4837	! hom(nzb_soil:nzt_soil,1,92,:) = SPREAD( m_soil_h%var_2d(nzb_soil:nzt_soil,1), &
4838	! 2, statistic_regions+1 )
4839
4840	!
4841	!-- Finally, make some consistency checks.
4842	!-- Ceck for illegal combination of LAI and vegetation coverage.
4843	IF ( ANY( .NOT. surf_lsm_h%pavement_surface .AND. &
4844	surf_lsm_h%lai == 0.0_wp .AND. surf_lsm_h%c_veg == 1.0_wp ) &
4845	) THEN
4846	message_string = 'For non-pavement surfaces the combination ' // &
4847	' lai = 0.0 and c_veg = 1.0 is not allowed.'
4848	CALL message( 'lsm_rrd_local', 'PA0671', 2, 2, 0, 6, 0 )
4849	ENDIF
4850
4851	DO l = 0, 3
4852	IF ( ANY( .NOT. surf_lsm_v(l)%pavement_surface .AND. &
4853	surf_lsm_v(l)%lai == 0.0_wp .AND. &
4854	surf_lsm_v(l)%c_veg == 1.0_wp ) ) THEN
4855	message_string = 'For non-pavement surfaces the combination ' // &
4856	' lai = 0.0 and c_veg = 1.0 is not allowed.'
4857	CALL message( 'lsm_rrd_local', 'PA0671', 2, 2, 0, 6, 0 )
4858	ENDIF
4859	ENDDO
4860	!
4861	!-- Check if roughness length for momentum, heat, or moisture exceed
4862	!-- surface-layer height and decrease local roughness length where
4863	!-- necessary.
4864	DO m = 1, surf_lsm_h%ns
4865	IF ( surf_lsm_h%z0(m) > 0.5_wp * surf_lsm_h%z_mo(m) ) THEN
4866
4867	surf_lsm_h%z0(m) = 0.5_wp * surf_lsm_h%z_mo(m)
4868
4869	WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // &
4870	'at horizontal natural surface and is ' // &
4871	'decreased appropriately at grid point (i,j) = ', &
4872	surf_lsm_h%i(m), surf_lsm_h%j(m)
4873	CALL message( 'land_surface_model_mod', 'PA0503', &
4874	0, 0, myid, 6, 0 )
4875	ENDIF
4876	IF ( surf_lsm_h%z0h(m) > 0.5_wp * surf_lsm_h%z_mo(m) ) THEN
4877
4878	surf_lsm_h%z0h(m) = 0.5_wp * surf_lsm_h%z_mo(m)
4879	surf_lsm_h%z0q(m) = 0.5_wp * surf_lsm_h%z_mo(m)
4880
4881	WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // &
4882	'at horizontal natural surface and is ' // &
4883	'decreased appropriately at grid point (i,j) = ', &
4884	surf_lsm_h%i(m), surf_lsm_h%j(m)
4885	CALL message( 'land_surface_model_mod', 'PA0507', &
4886	0, 0, myid, 6, 0 )
4887	ENDIF
4888	ENDDO
4889
4890	DO l = 0, 3
4891	DO m = 1, surf_lsm_v(l)%ns
4892	IF ( surf_lsm_v(l)%z0(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) ) THEN
4893
4894	surf_lsm_v(l)%z0(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
4895
4896	WRITE( message_string, * ) 'z0 exceeds surface-layer height '//&
4897	'at vertical natural surface and is ' // &
4898	'decreased appropriately at grid point (i,j) = ', &
4899	surf_lsm_v(l)%i(m)+surf_lsm_v(l)%ioff, &
4900	surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff
4901	CALL message( 'land_surface_model_mod', 'PA0503', &
4902	0, 0, myid, 6, 0 )
4903	ENDIF
4904	IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) ) THEN
4905
4906	surf_lsm_v(l)%z0h(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
4907	surf_lsm_v(l)%z0q(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
4908
4909	WRITE( message_string, * ) 'z0h exceeds surface-layer height '//&
4910	'at vertical natural surface and is ' // &
4911	'decreased appropriately at grid point (i,j) = ', &
4912	surf_lsm_v(l)%i(m)+surf_lsm_v(l)%ioff, &
4913	surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff
4914	CALL message( 'land_surface_model_mod', 'PA0507', &
4915	0, 0, myid, 6, 0 )
4916	ENDIF
4917	ENDDO
4918	ENDDO
4919
4920	IF ( debug_output ) CALL debug_message( 'lsm_init', 'end' )
4921
4922	END SUBROUTINE lsm_init
4923
4924
4925	!------------------------------------------------------------------------------!
4926	! Description:
4927	! ------------
4928	!> Allocate land surface model arrays and define pointers
4929	!------------------------------------------------------------------------------!
4930	SUBROUTINE lsm_init_arrays
4931
4932
4933	IMPLICIT NONE
4934
4935	INTEGER(iwp) :: l !< index indicating facing of surface array
4936
4937	ALLOCATE ( root_extr(nzb_soil:nzt_soil) )
4938	root_extr = 0.0_wp
4939
4940	!
4941	!-- Allocate surface and soil temperature / humidity. Please note,
4942	!-- these arrays are allocated according to surface-data structure,
4943	!-- even if they do not belong to the data type due to the
4944	!-- pointer arithmetric (TARGET attribute is not allowed in a data-type).
4945	!
4946	!-- Horizontal surfaces
4947	ALLOCATE ( m_liq_h_1%var_1d(1:surf_lsm_h%ns) )
4948	ALLOCATE ( m_liq_h_2%var_1d(1:surf_lsm_h%ns) )
4949	ALLOCATE ( t_surface_h_1%var_1d(1:surf_lsm_h%ns) )
4950	ALLOCATE ( t_surface_h_2%var_1d(1:surf_lsm_h%ns) )
4951	ALLOCATE ( m_soil_h_1%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
4952	ALLOCATE ( m_soil_h_2%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
4953	ALLOCATE ( t_soil_h_1%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
4954	ALLOCATE ( t_soil_h_2%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
4955	!
4956	!-- Vertical surfaces
4957	DO l = 0, 3
4958	ALLOCATE ( m_liq_v_1(l)%var_1d(1:surf_lsm_v(l)%ns) )
4959	ALLOCATE ( m_liq_v_2(l)%var_1d(1:surf_lsm_v(l)%ns) )
4960	ALLOCATE ( t_surface_v_1(l)%var_1d(1:surf_lsm_v(l)%ns) )
4961	ALLOCATE ( t_surface_v_2(l)%var_1d(1:surf_lsm_v(l)%ns) )
4962	ALLOCATE ( m_soil_v_1(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
4963	ALLOCATE ( m_soil_v_2(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
4964	ALLOCATE ( t_soil_v_1(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
4965	ALLOCATE ( t_soil_v_2(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
4966	ENDDO
4967
4968	!
4969	!-- Allocate array for heat flux in W/m2, required for radiation?
4970	!-- Consider to remove this array
4971	ALLOCATE( surf_lsm_h%surfhf(1:surf_lsm_h%ns) )
4972	DO l = 0, 3
4973	ALLOCATE( surf_lsm_v(l)%surfhf(1:surf_lsm_v(l)%ns) )
4974	ENDDO
4975
4976
4977	!
4978	!-- Allocate intermediate timestep arrays
4979	!-- Horizontal surfaces
4980	ALLOCATE ( tm_liq_h_m%var_1d(1:surf_lsm_h%ns) )
4981	ALLOCATE ( tt_surface_h_m%var_1d(1:surf_lsm_h%ns) )
4982	ALLOCATE ( tm_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
4983	ALLOCATE ( tt_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
4984	!
4985	!-- Horizontal surfaces
4986	DO l = 0, 3
4987	ALLOCATE ( tm_liq_v_m(l)%var_1d(1:surf_lsm_v(l)%ns) )
4988	ALLOCATE ( tt_surface_v_m(l)%var_1d(1:surf_lsm_v(l)%ns) )
4989	ALLOCATE ( tm_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
4990	ALLOCATE ( tt_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
4991	ENDDO
4992
4993	!
4994	!-- Allocate 2D vegetation model arrays
4995	!-- Horizontal surfaces
4996	ALLOCATE ( surf_lsm_h%building_surface(1:surf_lsm_h%ns) )
4997	ALLOCATE ( surf_lsm_h%c_liq(1:surf_lsm_h%ns) )
4998	ALLOCATE ( surf_lsm_h%c_surface(1:surf_lsm_h%ns) )
4999	ALLOCATE ( surf_lsm_h%c_veg(1:surf_lsm_h%ns) )
5000	ALLOCATE ( surf_lsm_h%f_sw_in(1:surf_lsm_h%ns) )
5001	ALLOCATE ( surf_lsm_h%ghf(1:surf_lsm_h%ns) )
5002	ALLOCATE ( surf_lsm_h%g_d(1:surf_lsm_h%ns) )
5003	ALLOCATE ( surf_lsm_h%lai(1:surf_lsm_h%ns) )
5004	ALLOCATE ( surf_lsm_h%lambda_surface_u(1:surf_lsm_h%ns) )
5005	ALLOCATE ( surf_lsm_h%lambda_surface_s(1:surf_lsm_h%ns) )
5006	ALLOCATE ( surf_lsm_h%nzt_pavement(1:surf_lsm_h%ns) )
5007	ALLOCATE ( surf_lsm_h%pavement_surface(1:surf_lsm_h%ns) )
5008	ALLOCATE ( surf_lsm_h%qsws_soil(1:surf_lsm_h%ns) )
5009	ALLOCATE ( surf_lsm_h%qsws_liq(1:surf_lsm_h%ns) )
5010	ALLOCATE ( surf_lsm_h%qsws_veg(1:surf_lsm_h%ns) )
5011	ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns) )
5012	ALLOCATE ( surf_lsm_h%r_a(1:surf_lsm_h%ns) )
5013	ALLOCATE ( surf_lsm_h%r_canopy(1:surf_lsm_h%ns) )
5014	ALLOCATE ( surf_lsm_h%r_soil(1:surf_lsm_h%ns) )
5015	ALLOCATE ( surf_lsm_h%r_soil_min(1:surf_lsm_h%ns) )
5016	ALLOCATE ( surf_lsm_h%r_s(1:surf_lsm_h%ns) )
5017	ALLOCATE ( surf_lsm_h%r_canopy_min(1:surf_lsm_h%ns) )
5018	ALLOCATE ( surf_lsm_h%vegetation_surface(1:surf_lsm_h%ns) )
5019	ALLOCATE ( surf_lsm_h%water_surface(1:surf_lsm_h%ns) )
5020
5021	surf_lsm_h%water_surface = .FALSE.
5022	surf_lsm_h%pavement_surface = .FALSE.
5023	surf_lsm_h%vegetation_surface = .FALSE.
5024
5025	!
5026	!-- Set default values
5027	surf_lsm_h%r_canopy_min = 0.0_wp
5028
5029	!
5030	!-- Vertical surfaces
5031	DO l = 0, 3
5032	ALLOCATE ( surf_lsm_v(l)%building_surface(1:surf_lsm_v(l)%ns) )
5033	ALLOCATE ( surf_lsm_v(l)%c_liq(1:surf_lsm_v(l)%ns) )
5034	ALLOCATE ( surf_lsm_v(l)%c_surface(1:surf_lsm_v(l)%ns) )
5035	ALLOCATE ( surf_lsm_v(l)%c_veg(1:surf_lsm_v(l)%ns) )
5036	ALLOCATE ( surf_lsm_v(l)%f_sw_in(1:surf_lsm_v(l)%ns) )
5037	ALLOCATE ( surf_lsm_v(l)%ghf(1:surf_lsm_v(l)%ns) )
5038	ALLOCATE ( surf_lsm_v(l)%g_d(1:surf_lsm_v(l)%ns) )
5039	ALLOCATE ( surf_lsm_v(l)%lai(1:surf_lsm_v(l)%ns) )
5040	ALLOCATE ( surf_lsm_v(l)%lambda_surface_u(1:surf_lsm_v(l)%ns) )
5041	ALLOCATE ( surf_lsm_v(l)%lambda_surface_s(1:surf_lsm_v(l)%ns) )
5042	ALLOCATE ( surf_lsm_v(l)%nzt_pavement(1:surf_lsm_v(l)%ns) )
5043	ALLOCATE ( surf_lsm_v(l)%pavement_surface(1:surf_lsm_v(l)%ns) )
5044	ALLOCATE ( surf_lsm_v(l)%qsws_soil(1:surf_lsm_v(l)%ns) )
5045	ALLOCATE ( surf_lsm_v(l)%qsws_liq(1:surf_lsm_v(l)%ns) )
5046	ALLOCATE ( surf_lsm_v(l)%qsws_veg(1:surf_lsm_v(l)%ns) )
5047	ALLOCATE ( surf_lsm_v(l)%rad_net_l(1:surf_lsm_v(l)%ns) )
5048	ALLOCATE ( surf_lsm_v(l)%r_a(1:surf_lsm_v(l)%ns) )
5049	ALLOCATE ( surf_lsm_v(l)%r_canopy(1:surf_lsm_v(l)%ns) )
5050	ALLOCATE ( surf_lsm_v(l)%r_soil(1:surf_lsm_v(l)%ns) )
5051	ALLOCATE ( surf_lsm_v(l)%r_soil_min(1:surf_lsm_v(l)%ns) )
5052	ALLOCATE ( surf_lsm_v(l)%r_s(1:surf_lsm_v(l)%ns) )
5053	ALLOCATE ( surf_lsm_v(l)%r_canopy_min(1:surf_lsm_v(l)%ns) )
5054	ALLOCATE ( surf_lsm_v(l)%vegetation_surface(1:surf_lsm_v(l)%ns) )
5055	ALLOCATE ( surf_lsm_v(l)%water_surface(1:surf_lsm_v(l)%ns) )
5056
5057	surf_lsm_v(l)%water_surface = .FALSE.
5058	surf_lsm_v(l)%pavement_surface = .FALSE.
5059	surf_lsm_v(l)%vegetation_surface = .FALSE.
5060
5061
5062	!
5063	!-- Set default values
5064	surf_lsm_v(l)%r_canopy_min = 0.0_wp
5065
5066	ENDDO
5067
5068	!
5069	!-- Initial assignment of the pointers
5070	!-- Horizontal surfaces
5071	t_soil_h => t_soil_h_1; t_soil_h_p => t_soil_h_2
5072	t_surface_h => t_surface_h_1; t_surface_h_p => t_surface_h_2
5073	m_soil_h => m_soil_h_1; m_soil_h_p => m_soil_h_2
5074	m_liq_h => m_liq_h_1; m_liq_h_p => m_liq_h_2
5075	!
5076	!-- Vertical surfaces
5077	t_soil_v => t_soil_v_1; t_soil_v_p => t_soil_v_2
5078	t_surface_v => t_surface_v_1; t_surface_v_p => t_surface_v_2
5079	m_soil_v => m_soil_v_1; m_soil_v_p => m_soil_v_2
5080	m_liq_v => m_liq_v_1; m_liq_v_p => m_liq_v_2
5081
5082
5083	END SUBROUTINE lsm_init_arrays
5084
5085
5086	!------------------------------------------------------------------------------!
5087	! Description:
5088	! ------------
5089	!> Parin for &lsmpar for land surface model
5090	!------------------------------------------------------------------------------!
5091	SUBROUTINE lsm_parin
5092
5093	USE control_parameters, &
5094	ONLY: message_string
5095
5096	IMPLICIT NONE
5097
5098	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
5099
5100	NAMELIST /lsm_par/ alpha_vangenuchten, c_surface, &
5101	canopy_resistance_coefficient, &
5102	constant_roughness, &
5103	conserve_water_content, &
5104	deep_soil_temperature, &
5105	dz_soil, &
5106	f_shortwave_incoming, field_capacity, &
5107	aero_resist_kray, hydraulic_conductivity, &
5108	lambda_surface_stable, &
5109	lambda_surface_unstable, leaf_area_index, &
5110	l_vangenuchten, min_canopy_resistance, &
5111	min_soil_resistance, n_vangenuchten, &
5112	pavement_depth_level, &
5113	pavement_heat_capacity, &
5114	pavement_heat_conduct, pavement_type, &
5115	residual_moisture, root_fraction, &
5116	saturation_moisture, skip_time_do_lsm, &
5117	soil_moisture, soil_temperature, &
5118	soil_type, &
5119	surface_type, &
5120	vegetation_coverage, vegetation_type, &
5121	water_temperature, water_type, &
5122	wilting_point, z0_vegetation, &
5123	z0h_vegetation, z0q_vegetation, z0_water, &
5124	z0h_water, z0q_water, z0_pavement, &
5125	z0h_pavement, z0q_pavement
5126
5127	NAMELIST /land_surface_parameters/ &
5128	alpha_vangenuchten, c_surface, &
5129	canopy_resistance_coefficient, &
5130	constant_roughness, &
5131	conserve_water_content, &
5132	deep_soil_temperature, &
5133	dz_soil, &
5134	f_shortwave_incoming, field_capacity, &
5135	aero_resist_kray, hydraulic_conductivity, &
5136	lambda_surface_stable, &
5137	lambda_surface_unstable, leaf_area_index, &
5138	l_vangenuchten, min_canopy_resistance, &
5139	min_soil_resistance, n_vangenuchten, &
5140	pavement_depth_level, &
5141	pavement_heat_capacity, &
5142	pavement_heat_conduct, pavement_type, &
5143	residual_moisture, root_fraction, &
5144	saturation_moisture, skip_time_do_lsm, &
5145	soil_moisture, soil_temperature, &
5146	soil_type, &
5147	surface_type, &
5148	vegetation_coverage, vegetation_type, &
5149	water_temperature, water_type, &
5150	wilting_point, z0_vegetation, &
5151	z0h_vegetation, z0q_vegetation, z0_water, &
5152	z0h_water, z0q_water, z0_pavement, &
5153	z0h_pavement, z0q_pavement
5154
5155	line = ' '
5156
5157	!
5158	!-- Try to find land surface model package
5159	REWIND ( 11 )
5160	line = ' '
5161	DO WHILE ( INDEX( line, '&land_surface_parameters' ) == 0 )
5162	READ ( 11, '(A)', END=12 ) line
5163	ENDDO
5164	BACKSPACE ( 11 )
5165
5166	!
5167	!-- Read user-defined namelist
5168	READ ( 11, land_surface_parameters, ERR = 10 )
5169
5170	!
5171	!-- Set flag that indicates that the land surface model is switched on
5172	land_surface = .TRUE.
5173
5174	GOTO 14
5175
5176	10 BACKSPACE( 11 )
5177	READ( 11 , '(A)') line
5178	CALL parin_fail_message( 'land_surface_parameters', line )
5179	!
5180	!-- Try to find old namelist
5181	12 REWIND ( 11 )
5182	line = ' '
5183	DO WHILE ( INDEX( line, '&lsm_par' ) == 0 )
5184	READ ( 11, '(A)', END=14 ) line
5185	ENDDO
5186	BACKSPACE ( 11 )
5187
5188	!
5189	!-- Read user-defined namelist
5190	READ ( 11, lsm_par, ERR = 13, END = 14 )
5191
5192	message_string = 'namelist lsm_par is deprecated and will be ' // &
5193	'removed in near future. Please use namelist ' // &
5194	'land_surface_parameters instead'
5195	CALL message( 'lsm_parin', 'PA0487', 0, 1, 0, 6, 0 )
5196
5197	!
5198	!-- Set flag that indicates that the land surface model is switched on
5199	land_surface = .TRUE.
5200
5201	GOTO 14
5202
5203	13 BACKSPACE( 11 )
5204	READ( 11 , '(A)') line
5205	CALL parin_fail_message( 'lsm_par', line )
5206
5207
5208	14 CONTINUE
5209
5210
5211	END SUBROUTINE lsm_parin
5212
5213
5214	!------------------------------------------------------------------------------!
5215	! Description:
5216	! ------------
5217	!> Soil model as part of the land surface model. The model predicts soil
5218	!> temperature and water content.
5219	!------------------------------------------------------------------------------!
5220	SUBROUTINE lsm_soil_model( horizontal, l, calc_soil_moisture )
5221
5222
5223	IMPLICIT NONE
5224
5225	INTEGER(iwp) :: k !< running index
5226	INTEGER(iwp) :: l !< surface-data type index indication facing
5227	INTEGER(iwp) :: m !< running index
5228
5229	LOGICAL, INTENT(IN) :: calc_soil_moisture !< flag indicating whether soil moisture shall be calculated or not.
5230
5231	LOGICAL :: horizontal !< flag indication horizontal wall, required to set pointer accordingly
5232
5233	REAL(wp) :: h_vg !< Van Genuchten coef. h
5234
5235	REAL(wp), DIMENSION(nzb_soil:nzt_soil) :: gamma_temp, & !< temp. gamma
5236	lambda_temp, & !< temp. lambda
5237	tend !< tendency
5238
5239	TYPE(surf_type_lsm), POINTER :: surf_m_soil
5240	TYPE(surf_type_lsm), POINTER :: surf_m_soil_p
5241	TYPE(surf_type_lsm), POINTER :: surf_t_soil
5242	TYPE(surf_type_lsm), POINTER :: surf_t_soil_p
5243	TYPE(surf_type_lsm), POINTER :: surf_tm_soil_m
5244	TYPE(surf_type_lsm), POINTER :: surf_tt_soil_m
5245
5246	TYPE(surf_type), POINTER :: surf !< surface-date type variable
5247
5248
5249	IF ( debug_output_timestep ) THEN
5250	WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
5251	CALL debug_message( debug_string, 'start' )
5252	ENDIF
5253
5254	IF ( horizontal ) THEN
5255	surf => surf_lsm_h
5256
5257	surf_m_soil => m_soil_h
5258	surf_m_soil_p => m_soil_h_p
5259	surf_t_soil => t_soil_h
5260	surf_t_soil_p => t_soil_h_p
5261	surf_tm_soil_m => tm_soil_h_m
5262	surf_tt_soil_m => tt_soil_h_m
5263	ELSE
5264	surf => surf_lsm_v(l)
5265
5266	surf_m_soil => m_soil_v(l)
5267	surf_m_soil_p => m_soil_v_p(l)
5268	surf_t_soil => t_soil_v(l)
5269	surf_t_soil_p => t_soil_v_p(l)
5270	surf_tm_soil_m => tm_soil_v_m(l)
5271	surf_tt_soil_m => tt_soil_v_m(l)
5272	ENDIF
5273
5274	!$OMP PARALLEL PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg, m_total)
5275	!$OMP DO SCHEDULE (STATIC)
5276	DO m = 1, surf%ns
5277
5278	IF ( .NOT. surf%water_surface(m) ) THEN
5279	DO k = nzb_soil, nzt_soil
5280
5281	IF ( surf%pavement_surface(m) .AND. &
5282	k <= surf%nzt_pavement(m) ) THEN
5283
5284	surf%rho_c_total(k,m) = surf%rho_c_total_def(k,m)
5285	lambda_temp(k) = surf%lambda_h_def(k,m)
5286
5287	ELSE
5288	!
5289	!-- Calculate volumetric heat capacity of the soil, taking
5290	!-- into account water content
5291	surf%rho_c_total(k,m) = (rho_c_soil * &
5292	( 1.0_wp - surf%m_sat(k,m) ) &
5293	+ rho_c_water * surf_m_soil%var_2d(k,m) )
5294
5295	!
5296	!-- Calculate soil heat conductivity at the center of the soil
5297	!-- layers
5298	lambda_h_sat = lambda_h_sm*(1.0_wp - surf%m_sat(k,m)) &
5299	lambda_h_water ** surf_m_soil%var_2d(k,m)
5300
5301	ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(k,m) / &
5302	surf%m_sat(k,m) ) )
5303
5304	lambda_temp(k) = ke * (lambda_h_sat - lambda_h_dry) + &
5305	lambda_h_dry
5306	ENDIF
5307	ENDDO
5308
5309	!
5310	!-- Calculate soil heat conductivity (lambda_h) at the _layer level
5311	!-- using linear interpolation. For pavement surface, the
5312	!-- true pavement depth is considered
5313	DO k = nzb_soil, nzt_soil-1
5314	surf%lambda_h(k,m) = ( lambda_temp(k+1) + lambda_temp(k) ) &
5315	* 0.5_wp
5316	ENDDO
5317	surf%lambda_h(nzt_soil,m) = lambda_temp(nzt_soil)
5318
5319	!
5320	!-- Prognostic equation for soil temperature t_soil
5321	tend(:) = 0.0_wp
5322
5323	tend(nzb_soil) = ( 1.0_wp / surf%rho_c_total(nzb_soil,m) ) * &
5324	( surf%lambda_h(nzb_soil,m) * ( surf_t_soil%var_2d(nzb_soil+1,m) &
5325	- surf_t_soil%var_2d(nzb_soil,m) ) * ddz_soil_center(nzb_soil) &
5326	+ surf%ghf(m) ) * ddz_soil(nzb_soil)
5327
5328	DO k = nzb_soil+1, nzt_soil
5329	tend(k) = ( 1.0_wp / surf%rho_c_total(k,m) ) &
5330	* ( surf%lambda_h(k,m) &
5331	* ( surf_t_soil%var_2d(k+1,m) - surf_t_soil%var_2d(k,m) ) &
5332	* ddz_soil_center(k) &
5333	- surf%lambda_h(k-1,m) &
5334	* ( surf_t_soil%var_2d(k,m) - surf_t_soil%var_2d(k-1,m) ) &
5335	* ddz_soil_center(k-1) &
5336	) * ddz_soil(k)
5337
5338	ENDDO
5339
5340	surf_t_soil_p%var_2d(nzb_soil:nzt_soil,m) = &
5341	surf_t_soil%var_2d(nzb_soil:nzt_soil,m) &
5342	+ dt_3d * ( tsc(2) &
5343	* tend(nzb_soil:nzt_soil) &
5344	+ tsc(3) &
5345	* surf_tt_soil_m%var_2d(nzb_soil:nzt_soil,m) )
5346
5347	!
5348	!-- Calculate t_soil tendencies for the next Runge-Kutta step
5349	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5350	IF ( intermediate_timestep_count == 1 ) THEN
5351	DO k = nzb_soil, nzt_soil
5352	surf_tt_soil_m%var_2d(k,m) = tend(k)
5353	ENDDO
5354	ELSEIF ( intermediate_timestep_count < &
5355	intermediate_timestep_count_max ) THEN
5356	DO k = nzb_soil, nzt_soil
5357	surf_tt_soil_m%var_2d(k,m) = -9.5625_wp * tend(k) + &
5358	5.3125_wp * &
5359	surf_tt_soil_m%var_2d(k,m)
5360	ENDDO
5361	ENDIF
5362	ENDIF
5363
5364
5365	DO k = nzb_soil, nzt_soil
5366
5367	!
5368	!-- In order to prevent water tranport through paved surfaces,
5369	!-- conductivity and diffusivity are set to zero
5370	IF ( surf%pavement_surface(m) .AND. &
5371	k <= surf%nzt_pavement(m) ) THEN
5372	lambda_temp(k) = 0.0_wp
5373	gamma_temp(k) = 0.0_wp
5374
5375	ELSE
5376
5377	!
5378	!-- Calculate soil diffusivity at the center of the soil layers
5379	lambda_temp(k) = (- b_ch * surf%gamma_w_sat(k,m) * psi_sat &
5380	/ surf%m_sat(k,m) ) * ( &
5381	MAX( surf_m_soil%var_2d(k,m), &
5382	surf%m_wilt(k,m) ) / surf%m_sat(k,m) )**( &
5383	b_ch + 2.0_wp )
5384
5385	!
5386	!-- Parametrization of Van Genuchten
5387	!-- Calculate the hydraulic conductivity after Van Genuchten (1980)
5388	h_vg = ( ( ( surf%m_res(k,m) - surf%m_sat(k,m) ) / &
5389	( surf%m_res(k,m) - &
5390	MAX( surf_m_soil%var_2d(k,m), surf%m_wilt(k,m) )&
5391	) &
5392	)**( &
5393	surf%n_vg(k,m) / ( surf%n_vg(k,m) - 1.0_wp ) &
5394	) - 1.0_wp &
5395	)**( 1.0_wp / surf%n_vg(k,m) ) / surf%alpha_vg(k,m)
5396
5397	gamma_temp(k) = surf%gamma_w_sat(k,m) * ( ( ( 1.0_wp + &
5398	( surf%alpha_vg(k,m) * h_vg )**surf%n_vg(k,m) &
5399	)**( &
5400	1.0_wp - 1.0_wp / surf%n_vg(k,m)) - ( &
5401	surf%alpha_vg(k,m) * h_vg )**( surf%n_vg(k,m) &
5402	- 1.0_wp) )**2 ) &
5403	/ ( ( 1.0_wp + ( surf%alpha_vg(k,m) * h_vg &
5404	)surf%n_vg(k,m) )( ( 1.0_wp - 1.0_wp &
5405	/ surf%n_vg(k,m) ) * &
5406	( surf%l_vg(k,m) + 2.0_wp) ) )
5407
5408	ENDIF
5409
5410	ENDDO
5411
5412
5413	IF ( calc_soil_moisture ) THEN
5414
5415	!
5416	!-- Prognostic equation for soil moisture content. Only performed,
5417	!-- when humidity is enabled in the atmosphere.
5418	IF ( humidity ) THEN
5419	!
5420	!-- Calculate soil diffusivity (lambda_w) at the _layer level
5421	!-- using linear interpolation. To do: replace this with
5422	!-- ECMWF-IFS Eq. 8.81
5423	DO k = nzb_soil, nzt_soil-1
5424
5425	surf%lambda_w(k,m) = ( lambda_temp(k+1) + lambda_temp(k) ) &
5426	* 0.5_wp
5427	surf%gamma_w(k,m) = ( gamma_temp(k+1) + gamma_temp(k) ) &
5428	* 0.5_wp
5429
5430	ENDDO
5431	!
5432	!
5433	!-- In case of a closed bottom (= water content is conserved),
5434	!-- set hydraulic conductivity to zero to that no water will be
5435	!-- lost in the bottom layer. As gamma_w is always a positive value,
5436	!-- it cannot be set to zero in case of purely dry soil since this
5437	!-- would cause accumulation of (non-existing) water in the lowest
5438	!-- soil layer
5439	IF ( conserve_water_content .AND. &
5440	surf_m_soil%var_2d(nzt_soil,m) /= 0.0_wp ) THEN
5441
5442	surf%gamma_w(nzt_soil,m) = 0.0_wp
5443	ELSE
5444	surf%gamma_w(nzt_soil,m) = gamma_temp(nzt_soil)
5445	ENDIF
5446
5447	!-- The root extraction (= root_extr * qsws_veg / (rho_l
5448	!-- * l_v)) ensures the mass conservation for water. The
5449	!-- transpiration of plants equals the cumulative withdrawals by
5450	!-- the roots in the soil. The scheme takes into account the
5451	!-- availability of water in the soil layers as well as the root
5452	!-- fraction in the respective layer. Layer with moisture below
5453	!-- wilting point will not contribute, which reflects the
5454	!-- preference of plants to take water from moister layers.
5455	!
5456	!-- Calculate the root extraction (ECMWF 7.69, the sum of
5457	!-- root_extr = 1). The energy balance solver guarantees a
5458	!-- positive transpiration, so that there is no need for an
5459	!-- additional check.
5460	m_total = 0.0_wp
5461	DO k = nzb_soil, nzt_soil
5462	IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(k,m) ) THEN
5463	m_total = m_total + surf%root_fr(k,m) &
5464	* surf_m_soil%var_2d(k,m)
5465	ENDIF
5466	ENDDO
5467	IF ( m_total > 0.0_wp ) THEN
5468	DO k = nzb_soil, nzt_soil
5469	IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(k,m) ) THEN
5470	root_extr(k) = surf%root_fr(k,m) &
5471	* surf_m_soil%var_2d(k,m) / m_total
5472	ELSE
5473	root_extr(k) = 0.0_wp
5474	ENDIF
5475	ENDDO
5476	ENDIF
5477	!
5478	!-- Prognostic equation for soil water content m_soil_h.
5479	tend(:) = 0.0_wp
5480
5481	tend(nzb_soil) = ( surf%lambda_w(nzb_soil,m) * ( &
5482	surf_m_soil%var_2d(nzb_soil+1,m) &
5483	- surf_m_soil%var_2d(nzb_soil,m) ) &
5484	* ddz_soil_center(nzb_soil) - surf%gamma_w(nzb_soil,m)&
5485	- ( root_extr(nzb_soil) * surf%qsws_veg(m) &
5486	+ surf%qsws_soil(m) ) * drho_l_lv ) &
5487	* ddz_soil(nzb_soil)
5488
5489	DO k = nzb_soil+1, nzt_soil-1
5490	tend(k) = ( surf%lambda_w(k,m) * ( surf_m_soil%var_2d(k+1,m) &
5491	- surf_m_soil%var_2d(k,m) ) * ddz_soil_center(k) &
5492	- surf%gamma_w(k,m) &
5493	- surf%lambda_w(k-1,m) * ( surf_m_soil%var_2d(k,m) &
5494	- surf_m_soil%var_2d(k-1,m)) * ddz_soil_center(k-1) &
5495	+ surf%gamma_w(k-1,m) - (root_extr(k) &
5496	* surf%qsws_veg(m) * drho_l_lv) &
5497	) * ddz_soil(k)
5498	ENDDO
5499	tend(nzt_soil) = ( - surf%gamma_w(nzt_soil,m) &
5500	- surf%lambda_w(nzt_soil-1,m) &
5501	* ( surf_m_soil%var_2d(nzt_soil,m) &
5502	- surf_m_soil%var_2d(nzt_soil-1,m)) &
5503	* ddz_soil_center(nzt_soil-1) &
5504	+ surf%gamma_w(nzt_soil-1,m) - ( &
5505	root_extr(nzt_soil) &
5506	* surf%qsws_veg(m) * drho_l_lv ) &
5507	) * ddz_soil(nzt_soil)
5508
5509	surf_m_soil_p%var_2d(nzb_soil:nzt_soil,m) = &
5510	surf_m_soil%var_2d(nzb_soil:nzt_soil,m) &
5511	+ dt_3d * ( tsc(2) * tend(:) &
5512	+ tsc(3) * surf_tm_soil_m%var_2d(:,m) )
5513
5514	!
5515	!-- Account for dry and wet soils to keep solution stable
5516	!-- (mass conservation is violated here)
5517	DO k = nzb_soil, nzt_soil
5518	surf_m_soil_p%var_2d(k,m) = MIN( surf_m_soil_p%var_2d(k,m), surf%m_sat(k,m) )
5519	surf_m_soil_p%var_2d(k,m) = MAX( surf_m_soil_p%var_2d(k,m), 0.0_wp )
5520	ENDDO
5521
5522	!
5523	!-- Calculate m_soil tendencies for the next Runge-Kutta step
5524	IF ( timestep_scheme(1:5) == 'runge' ) THEN
5525	IF ( intermediate_timestep_count == 1 ) THEN
5526	DO k = nzb_soil, nzt_soil
5527	surf_tm_soil_m%var_2d(k,m) = tend(k)
5528	ENDDO
5529	ELSEIF ( intermediate_timestep_count < &
5530	intermediate_timestep_count_max ) THEN
5531	DO k = nzb_soil, nzt_soil
5532	surf_tm_soil_m%var_2d(k,m) = -9.5625_wp * tend(k) &
5533	+ 5.3125_wp &
5534	* surf_tm_soil_m%var_2d(k,m)
5535	ENDDO
5536
5537	ENDIF
5538
5539	ENDIF
5540
5541	ENDIF
5542
5543	ENDIF
5544
5545	ENDIF
5546
5547	ENDDO
5548	!$OMP END PARALLEL
5549	!
5550	!-- Debug location message
5551	IF ( debug_output_timestep ) THEN
5552	WRITE( debug_string, * ) 'lsm_soil_model', horizontal, l, calc_soil_moisture
5553	CALL debug_message( debug_string, 'end' )
5554	ENDIF
5555
5556	END SUBROUTINE lsm_soil_model
5557
5558
5559	!------------------------------------------------------------------------------!
5560	! Description:
5561	! ------------
5562	!> Swapping of timelevels
5563	!------------------------------------------------------------------------------!
5564	SUBROUTINE lsm_swap_timelevel ( mod_count )
5565
5566	IMPLICIT NONE
5567
5568	INTEGER, INTENT(IN) :: mod_count
5569
5570
5571	SELECT CASE ( mod_count )
5572
5573	CASE ( 0 )
5574	!
5575	!-- Horizontal surfaces
5576	t_surface_h => t_surface_h_1; t_surface_h_p => t_surface_h_2
5577	t_soil_h => t_soil_h_1; t_soil_h_p => t_soil_h_2
5578	IF ( humidity ) THEN
5579	m_soil_h => m_soil_h_1; m_soil_h_p => m_soil_h_2
5580	m_liq_h => m_liq_h_1; m_liq_h_p => m_liq_h_2
5581	ENDIF
5582
5583	!
5584	!-- Vertical surfaces
5585	t_surface_v => t_surface_v_1; t_surface_v_p => t_surface_v_2
5586	t_soil_v => t_soil_v_1; t_soil_v_p => t_soil_v_2
5587	IF ( humidity ) THEN
5588	m_soil_v => m_soil_v_1; m_soil_v_p => m_soil_v_2
5589	m_liq_v => m_liq_v_1; m_liq_v_p => m_liq_v_2
5590
5591	ENDIF
5592
5593
5594
5595	CASE ( 1 )
5596	!
5597	!-- Horizontal surfaces
5598	t_surface_h => t_surface_h_2; t_surface_h_p => t_surface_h_1
5599	t_soil_h => t_soil_h_2; t_soil_h_p => t_soil_h_1
5600	IF ( humidity ) THEN
5601	m_soil_h => m_soil_h_2; m_soil_h_p => m_soil_h_1
5602	m_liq_h => m_liq_h_2; m_liq_h_p => m_liq_h_1
5603
5604	ENDIF
5605	!
5606	!-- Vertical surfaces
5607	t_surface_v => t_surface_v_2; t_surface_v_p => t_surface_v_1
5608	t_soil_v => t_soil_v_2; t_soil_v_p => t_soil_v_1
5609	IF ( humidity ) THEN
5610	m_soil_v => m_soil_v_2; m_soil_v_p => m_soil_v_1
5611	m_liq_v => m_liq_v_2; m_liq_v_p => m_liq_v_1
5612	ENDIF
5613
5614	END SELECT
5615
5616	END SUBROUTINE lsm_swap_timelevel
5617
5618
5619
5620
5621	!------------------------------------------------------------------------------!
5622	!
5623	! Description:
5624	! ------------
5625	!> Subroutine for averaging 3D data
5626	!------------------------------------------------------------------------------!
5627	SUBROUTINE lsm_3d_data_averaging( mode, variable )
5628
5629
5630	USE control_parameters
5631
5632	USE indices
5633
5634	IMPLICIT NONE
5635
5636	CHARACTER (LEN=*) :: mode !<
5637	CHARACTER (LEN=*) :: variable !<
5638
5639	INTEGER(iwp) :: i !<
5640	INTEGER(iwp) :: j !<
5641	INTEGER(iwp) :: k !<
5642	INTEGER(iwp) :: m !< running index
5643
5644	IF ( mode == 'allocate' ) THEN
5645
5646	SELECT CASE ( TRIM( variable ) )
5647
5648	CASE ( 'c_liq*' )
5649	IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN
5650	ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
5651	ENDIF
5652	c_liq_av = 0.0_wp
5653
5654	CASE ( 'c_soil*' )
5655	IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN
5656	ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
5657	ENDIF
5658	c_soil_av = 0.0_wp
5659
5660	CASE ( 'c_veg*' )
5661	IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN
5662	ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
5663	ENDIF
5664	c_veg_av = 0.0_wp
5665
5666	CASE ( 'lai*' )
5667	IF ( .NOT. ALLOCATED( lai_av ) ) THEN
5668	ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
5669	ENDIF
5670	lai_av = 0.0_wp
5671
5672	CASE ( 'm_liq*' )
5673	IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN
5674	ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
5675	ENDIF
5676	m_liq_av = 0.0_wp
5677
5678	CASE ( 'm_soil' )
5679	IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN
5680	ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
5681	ENDIF
5682	m_soil_av = 0.0_wp
5683
5684	CASE ( 'qsws_liq*' )
5685	IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN
5686	ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
5687	ENDIF
5688	qsws_liq_av = 0.0_wp
5689
5690	CASE ( 'qsws_soil*' )
5691	IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN
5692	ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
5693	ENDIF
5694	qsws_soil_av = 0.0_wp
5695
5696	CASE ( 'qsws_veg*' )
5697	IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN
5698	ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
5699	ENDIF
5700	qsws_veg_av = 0.0_wp
5701
5702	CASE ( 'r_s*' )
5703	IF ( .NOT. ALLOCATED( r_s_av ) ) THEN
5704	ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) )
5705	ENDIF
5706	r_s_av = 0.0_wp
5707
5708	CASE ( 't_soil' )
5709	IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN
5710	ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
5711	ENDIF
5712	t_soil_av = 0.0_wp
5713
5714	CASE DEFAULT
5715	CONTINUE
5716
5717	END SELECT
5718
5719	ELSEIF ( mode == 'sum' ) THEN
5720
5721	SELECT CASE ( TRIM( variable ) )
5722
5723	CASE ( 'c_liq*' )
5724	IF ( ALLOCATED( c_liq_av ) ) THEN
5725	DO m = 1, surf_lsm_h%ns
5726	i = surf_lsm_h%i(m)
5727	j = surf_lsm_h%j(m)
5728	c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h%c_liq(m)
5729	ENDDO
5730	ENDIF
5731
5732	CASE ( 'c_soil*' )
5733	IF ( ALLOCATED( c_soil_av ) ) THEN
5734	DO m = 1, surf_lsm_h%ns
5735	i = surf_lsm_h%i(m)
5736	j = surf_lsm_h%j(m)
5737	c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h%c_veg(m))
5738	ENDDO
5739	ENDIF
5740
5741	CASE ( 'c_veg*' )
5742	IF ( ALLOCATED( c_veg_av ) ) THEN
5743	DO m = 1, surf_lsm_h%ns
5744	i = surf_lsm_h%i(m)
5745	j = surf_lsm_h%j(m)
5746	c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h%c_veg(m)
5747	ENDDO
5748	ENDIF
5749
5750	CASE ( 'lai*' )
5751	IF ( ALLOCATED( lai_av ) ) THEN
5752	DO m = 1, surf_lsm_h%ns
5753	i = surf_lsm_h%i(m)
5754	j = surf_lsm_h%j(m)
5755	lai_av(j,i) = lai_av(j,i) + surf_lsm_h%lai(m)
5756	ENDDO
5757	ENDIF
5758
5759	CASE ( 'm_liq*' )
5760	IF ( ALLOCATED( m_liq_av ) ) THEN
5761	DO m = 1, surf_lsm_h%ns
5762	i = surf_lsm_h%i(m)
5763	j = surf_lsm_h%j(m)
5764	m_liq_av(j,i) = m_liq_av(j,i) + m_liq_h%var_1d(m)
5765	ENDDO
5766	ENDIF
5767
5768	CASE ( 'm_soil' )
5769	IF ( ALLOCATED( m_soil_av ) ) THEN
5770	DO m = 1, surf_lsm_h%ns
5771	i = surf_lsm_h%i(m)
5772	j = surf_lsm_h%j(m)
5773	DO k = nzb_soil, nzt_soil
5774	m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil_h%var_2d(k,m)
5775	ENDDO
5776	ENDDO
5777	ENDIF
5778
5779	CASE ( 'qsws_liq*' )
5780	IF ( ALLOCATED( qsws_liq_av ) ) THEN
5781	DO m = 1, surf_lsm_h%ns
5782	i = surf_lsm_h%i(m)
5783	j = surf_lsm_h%j(m)
5784	qsws_liq_av(j,i) = qsws_liq_av(j,i) + &
5785	surf_lsm_h%qsws_liq(m)
5786	ENDDO
5787	ENDIF
5788
5789	CASE ( 'qsws_soil*' )
5790	IF ( ALLOCATED( qsws_soil_av ) ) THEN
5791	DO m = 1, surf_lsm_h%ns
5792	i = surf_lsm_h%i(m)
5793	j = surf_lsm_h%j(m)
5794	qsws_soil_av(j,i) = qsws_soil_av(j,i) + &
5795	surf_lsm_h%qsws_soil(m)
5796	ENDDO
5797	ENDIF
5798
5799	CASE ( 'qsws_veg*' )
5800	IF ( ALLOCATED(qsws_veg_av ) ) THEN
5801	DO m = 1, surf_lsm_h%ns
5802	i = surf_lsm_h%i(m)
5803	j = surf_lsm_h%j(m)
5804	qsws_veg_av(j,i) = qsws_veg_av(j,i) + &
5805	surf_lsm_h%qsws_veg(m)
5806	ENDDO
5807	ENDIF
5808
5809	CASE ( 'r_s*' )
5810	IF ( ALLOCATED( r_s_av) ) THEN
5811	DO m = 1, surf_lsm_h%ns
5812	i = surf_lsm_h%i(m)
5813	j = surf_lsm_h%j(m)
5814	r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h%r_s(m)
5815	ENDDO
5816	ENDIF
5817
5818	CASE ( 't_soil' )
5819	IF ( ALLOCATED( t_soil_av ) ) THEN
5820	DO m = 1, surf_lsm_h%ns
5821	i = surf_lsm_h%i(m)
5822	j = surf_lsm_h%j(m)
5823	DO k = nzb_soil, nzt_soil
5824	t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil_h%var_2d(k,m)
5825	ENDDO
5826	ENDDO
5827	ENDIF
5828
5829	CASE DEFAULT
5830	CONTINUE
5831
5832	END SELECT
5833
5834	ELSEIF ( mode == 'average' ) THEN
5835
5836	SELECT CASE ( TRIM( variable ) )
5837
5838	CASE ( 'c_liq*' )
5839	IF ( ALLOCATED( c_liq_av ) ) THEN
5840	DO i = nxl, nxr
5841	DO j = nys, nyn
5842	c_liq_av(j,i) = c_liq_av(j,i) &
5843	/ REAL( average_count_3d, KIND=wp )
5844	ENDDO
5845	ENDDO
5846	ENDIF
5847
5848	CASE ( 'c_soil*' )
5849	IF ( ALLOCATED( c_soil_av ) ) THEN
5850	DO i = nxl, nxr
5851	DO j = nys, nyn
5852	c_soil_av(j,i) = c_soil_av(j,i) &
5853	/ REAL( average_count_3d, KIND=wp )
5854	ENDDO
5855	ENDDO
5856	ENDIF
5857
5858	CASE ( 'c_veg*' )
5859	IF ( ALLOCATED( c_veg_av ) ) THEN
5860	DO i = nxl, nxr
5861	DO j = nys, nyn
5862	c_veg_av(j,i) = c_veg_av(j,i) &
5863	/ REAL( average_count_3d, KIND=wp )
5864	ENDDO
5865	ENDDO
5866	ENDIF
5867
5868	CASE ( 'lai*' )
5869	IF ( ALLOCATED( lai_av ) ) THEN
5870	DO i = nxl, nxr
5871	DO j = nys, nyn
5872	lai_av(j,i) = lai_av(j,i) &
5873	/ REAL( average_count_3d, KIND=wp )
5874	ENDDO
5875	ENDDO
5876	ENDIF
5877
5878	CASE ( 'm_liq*' )
5879	IF ( ALLOCATED( m_liq_av ) ) THEN
5880	DO i = nxl, nxr
5881	DO j = nys, nyn
5882	m_liq_av(j,i) = m_liq_av(j,i) &
5883	/ REAL( average_count_3d, KIND=wp )
5884	ENDDO
5885	ENDDO
5886	ENDIF
5887
5888	CASE ( 'm_soil' )
5889	IF ( ALLOCATED( m_soil_av ) ) THEN
5890	DO i = nxl, nxr
5891	DO j = nys, nyn
5892	DO k = nzb_soil, nzt_soil
5893	m_soil_av(k,j,i) = m_soil_av(k,j,i) &
5894	/ REAL( average_count_3d, KIND=wp )
5895	ENDDO
5896	ENDDO
5897	ENDDO
5898	ENDIF
5899
5900	CASE ( 'qsws_liq*' )
5901	IF ( ALLOCATED( qsws_liq_av ) ) THEN
5902	DO i = nxl, nxr
5903	DO j = nys, nyn
5904	qsws_liq_av(j,i) = qsws_liq_av(j,i) &
5905	/ REAL( average_count_3d, KIND=wp )
5906	ENDDO
5907	ENDDO
5908	ENDIF
5909
5910	CASE ( 'qsws_soil*' )
5911	IF ( ALLOCATED( qsws_soil_av ) ) THEN
5912	DO i = nxl, nxr
5913	DO j = nys, nyn
5914	qsws_soil_av(j,i) = qsws_soil_av(j,i) &
5915	/ REAL( average_count_3d, KIND=wp )
5916	ENDDO
5917	ENDDO
5918	ENDIF
5919
5920	CASE ( 'qsws_veg*' )
5921	IF ( ALLOCATED( qsws_veg_av ) ) THEN
5922	DO i = nxl, nxr
5923	DO j = nys, nyn
5924	qsws_veg_av(j,i) = qsws_veg_av(j,i) &
5925	/ REAL( average_count_3d, KIND=wp )
5926	ENDDO
5927	ENDDO
5928	ENDIF
5929
5930	CASE ( 'r_s*' )
5931	IF ( ALLOCATED( r_s_av ) ) THEN
5932	DO i = nxl, nxr
5933	DO j = nys, nyn
5934	r_s_av(j,i) = r_s_av(j,i) &
5935	/ REAL( average_count_3d, KIND=wp )
5936	ENDDO
5937	ENDDO
5938	ENDIF
5939
5940	CASE ( 't_soil' )
5941	IF ( ALLOCATED( t_soil_av ) ) THEN
5942	DO i = nxl, nxr
5943	DO j = nys, nyn
5944	DO k = nzb_soil, nzt_soil
5945	t_soil_av(k,j,i) = t_soil_av(k,j,i) &
5946	/ REAL( average_count_3d, KIND=wp )
5947	ENDDO
5948	ENDDO
5949	ENDDO
5950	ENDIF
5951	!
5952	!--
5953
5954	END SELECT
5955
5956	ENDIF
5957
5958	END SUBROUTINE lsm_3d_data_averaging
5959
5960
5961	!------------------------------------------------------------------------------!
5962	!
5963	! Description:
5964	! ------------
5965	!> Subroutine defining appropriate grid for netcdf variables.
5966	!> It is called out from subroutine netcdf.
5967	!------------------------------------------------------------------------------!
5968	SUBROUTINE lsm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
5969
5970	IMPLICIT NONE
5971
5972	CHARACTER (LEN=*), INTENT(IN) :: var !<
5973	LOGICAL, INTENT(OUT) :: found !<
5974	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
5975	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
5976	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
5977
5978	found = .TRUE.
5979
5980	!
5981	!-- Check for the grid
5982	SELECT CASE ( TRIM( var ) )
5983
5984	CASE ( 'm_soil', 't_soil', 'm_soil_xy', 't_soil_xy', 'm_soil_xz', &
5985	't_soil_xz', 'm_soil_yz', 't_soil_yz' )
5986	grid_x = 'x'
5987	grid_y = 'y'
5988	grid_z = 'zs'
5989
5990	CASE DEFAULT
5991	found = .FALSE.
5992	grid_x = 'none'
5993	grid_y = 'none'
5994	grid_z = 'none'
5995	END SELECT
5996
5997	END SUBROUTINE lsm_define_netcdf_grid
5998
5999	!------------------------------------------------------------------------------!
6000	!
6001	! Description:
6002	! ------------
6003	!> Subroutine defining 3D output variables
6004	!------------------------------------------------------------------------------!
6005	SUBROUTINE lsm_data_output_2d( av, variable, found, grid, mode, local_pf, &
6006	two_d, nzb_do, nzt_do )
6007
6008	USE indices
6009
6010
6011	IMPLICIT NONE
6012
6013	CHARACTER (LEN=*) :: grid !<
6014	CHARACTER (LEN=*) :: mode !<
6015	CHARACTER (LEN=*) :: variable !<
6016
6017	INTEGER(iwp) :: av !<
6018	INTEGER(iwp) :: i !< running index
6019	INTEGER(iwp) :: j !< running index
6020	INTEGER(iwp) :: k !< running index
6021	INTEGER(iwp) :: m !< running index
6022	INTEGER(iwp) :: nzb_do !<
6023	INTEGER(iwp) :: nzt_do !<
6024
6025	LOGICAL :: found !<
6026	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
6027
6028	REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
6029
6030	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
6031
6032
6033	found = .TRUE.
6034
6035	SELECT CASE ( TRIM( variable ) )
6036	!
6037	!-- Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein.
6038	!-- However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged.
6039	CASE ( 'c_liq*_xy' ) ! 2d-array
6040	IF ( av == 0 ) THEN
6041	DO m = 1, surf_lsm_h%ns
6042	i = surf_lsm_h%i(m)
6043	j = surf_lsm_h%j(m)
6044	local_pf(i,j,nzb+1) = surf_lsm_h%c_liq(m) * surf_lsm_h%c_veg(m)
6045	ENDDO
6046	ELSE
6047	IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN
6048	ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
6049	c_liq_av = REAL( fill_value, KIND = wp )
6050	ENDIF
6051	DO i = nxl, nxr
6052	DO j = nys, nyn
6053	local_pf(i,j,nzb+1) = c_liq_av(j,i)
6054	ENDDO
6055	ENDDO
6056	ENDIF
6057
6058	two_d = .TRUE.
6059	grid = 'zu1'
6060
6061	CASE ( 'c_soil*_xy' ) ! 2d-array
6062	IF ( av == 0 ) THEN
6063	DO m = 1, surf_lsm_h%ns
6064	i = surf_lsm_h%i(m)
6065	j = surf_lsm_h%j(m)
6066	local_pf(i,j,nzb+1) = 1.0_wp - surf_lsm_h%c_veg(m)
6067	ENDDO
6068	ELSE
6069	IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN
6070	ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
6071	c_soil_av = REAL( fill_value, KIND = wp )
6072	ENDIF
6073	DO i = nxl, nxr
6074	DO j = nys, nyn
6075	local_pf(i,j,nzb+1) = c_soil_av(j,i)
6076	ENDDO
6077	ENDDO
6078	ENDIF
6079
6080	two_d = .TRUE.
6081	grid = 'zu1'
6082
6083	CASE ( 'c_veg*_xy' ) ! 2d-array
6084	IF ( av == 0 ) THEN
6085	DO m = 1, surf_lsm_h%ns
6086	i = surf_lsm_h%i(m)
6087	j = surf_lsm_h%j(m)
6088	local_pf(i,j,nzb+1) = surf_lsm_h%c_veg(m)
6089	ENDDO
6090	ELSE
6091	IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN
6092	ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
6093	c_veg_av = REAL( fill_value, KIND = wp )
6094	ENDIF
6095	DO i = nxl, nxr
6096	DO j = nys, nyn
6097	local_pf(i,j,nzb+1) = c_veg_av(j,i)
6098	ENDDO
6099	ENDDO
6100	ENDIF
6101
6102	two_d = .TRUE.
6103	grid = 'zu1'
6104
6105	CASE ( 'lai*_xy' ) ! 2d-array
6106	IF ( av == 0 ) THEN
6107	DO m = 1, surf_lsm_h%ns
6108	i = surf_lsm_h%i(m)
6109	j = surf_lsm_h%j(m)
6110	local_pf(i,j,nzb+1) = surf_lsm_h%lai(m)
6111	ENDDO
6112	ELSE
6113	IF ( .NOT. ALLOCATED( lai_av ) ) THEN
6114	ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
6115	lai_av = REAL( fill_value, KIND = wp )
6116	ENDIF
6117	DO i = nxl, nxr
6118	DO j = nys, nyn
6119	local_pf(i,j,nzb+1) = lai_av(j,i)
6120	ENDDO
6121	ENDDO
6122	ENDIF
6123
6124	two_d = .TRUE.
6125	grid = 'zu1'
6126
6127	CASE ( 'm_liq*_xy' ) ! 2d-array
6128	IF ( av == 0 ) THEN
6129	DO m = 1, surf_lsm_h%ns
6130	i = surf_lsm_h%i(m)
6131	j = surf_lsm_h%j(m)
6132	local_pf(i,j,nzb+1) = m_liq_h%var_1d(m)
6133	ENDDO
6134	ELSE
6135	IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN
6136	ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
6137	m_liq_av = REAL( fill_value, KIND = wp )
6138	ENDIF
6139	DO i = nxl, nxr
6140	DO j = nys, nyn
6141	local_pf(i,j,nzb+1) = m_liq_av(j,i)
6142	ENDDO
6143	ENDDO
6144	ENDIF
6145
6146	two_d = .TRUE.
6147	grid = 'zu1'
6148
6149	CASE ( 'm_soil_xy', 'm_soil_xz', 'm_soil_yz' )
6150	IF ( av == 0 ) THEN
6151	DO m = 1, surf_lsm_h%ns
6152	i = surf_lsm_h%i(m)
6153	j = surf_lsm_h%j(m)
6154	DO k = nzb_soil, nzt_soil
6155	local_pf(i,j,k) = m_soil_h%var_2d(k,m)
6156	ENDDO
6157	ENDDO
6158	ELSE
6159	IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN
6160	ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6161	m_soil_av = REAL( fill_value, KIND = wp )
6162	ENDIF
6163	DO i = nxl, nxr
6164	DO j = nys, nyn
6165	DO k = nzb_soil, nzt_soil
6166	local_pf(i,j,k) = m_soil_av(k,j,i)
6167	ENDDO
6168	ENDDO
6169	ENDDO
6170	ENDIF
6171
6172	nzb_do = nzb_soil
6173	nzt_do = nzt_soil
6174
6175	IF ( mode == 'xy' ) grid = 'zs'
6176
6177	CASE ( 'qsws_liq*_xy' ) ! 2d-array
6178	IF ( av == 0 ) THEN
6179	DO m = 1, surf_lsm_h%ns
6180	i = surf_lsm_h%i(m)
6181	j = surf_lsm_h%j(m)
6182	local_pf(i,j,nzb+1) = surf_lsm_h%qsws_liq(m)
6183	ENDDO
6184	ELSE
6185	IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN
6186	ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
6187	qsws_liq_av = REAL( fill_value, KIND = wp )
6188	ENDIF
6189	DO i = nxl, nxr
6190	DO j = nys, nyn
6191	local_pf(i,j,nzb+1) = qsws_liq_av(j,i)
6192	ENDDO
6193	ENDDO
6194	ENDIF
6195
6196	two_d = .TRUE.
6197	grid = 'zu1'
6198
6199	CASE ( 'qsws_soil*_xy' ) ! 2d-array
6200	IF ( av == 0 ) THEN
6201	DO m = 1, surf_lsm_h%ns
6202	i = surf_lsm_h%i(m)
6203	j = surf_lsm_h%j(m)
6204	local_pf(i,j,nzb+1) = surf_lsm_h%qsws_soil(m)
6205	ENDDO
6206	ELSE
6207	IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN
6208	ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
6209	qsws_soil_av = REAL( fill_value, KIND = wp )
6210	ENDIF
6211	DO i = nxl, nxr
6212	DO j = nys, nyn
6213	local_pf(i,j,nzb+1) = qsws_soil_av(j,i)
6214	ENDDO
6215	ENDDO
6216	ENDIF
6217
6218	two_d = .TRUE.
6219	grid = 'zu1'
6220
6221	CASE ( 'qsws_veg*_xy' ) ! 2d-array
6222	IF ( av == 0 ) THEN
6223	DO m = 1, surf_lsm_h%ns
6224	i = surf_lsm_h%i(m)
6225	j = surf_lsm_h%j(m)
6226	local_pf(i,j,nzb+1) = surf_lsm_h%qsws_veg(m)
6227	ENDDO
6228	ELSE
6229	IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN
6230	ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
6231	qsws_veg_av = REAL( fill_value, KIND = wp )
6232	ENDIF
6233	DO i = nxl, nxr
6234	DO j = nys, nyn
6235	local_pf(i,j,nzb+1) = qsws_veg_av(j,i)
6236	ENDDO
6237	ENDDO
6238	ENDIF
6239
6240	two_d = .TRUE.
6241	grid = 'zu1'
6242
6243
6244	CASE ( 'r_s*_xy' ) ! 2d-array
6245	IF ( av == 0 ) THEN
6246	DO m = 1, surf_lsm_h%ns
6247	i = surf_lsm_h%i(m)
6248	j = surf_lsm_h%j(m)
6249	local_pf(i,j,nzb+1) = surf_lsm_h%r_s(m)
6250	ENDDO
6251	ELSE
6252	IF ( .NOT. ALLOCATED( r_s_av ) ) THEN
6253	ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) )
6254	r_s_av = REAL( fill_value, KIND = wp )
6255	ENDIF
6256	DO i = nxl, nxr
6257	DO j = nys, nyn
6258	local_pf(i,j,nzb+1) = r_s_av(j,i)
6259	ENDDO
6260	ENDDO
6261	ENDIF
6262
6263	two_d = .TRUE.
6264	grid = 'zu1'
6265
6266	CASE ( 't_soil_xy', 't_soil_xz', 't_soil_yz' )
6267	IF ( av == 0 ) THEN
6268	DO m = 1, surf_lsm_h%ns
6269	i = surf_lsm_h%i(m)
6270	j = surf_lsm_h%j(m)
6271	DO k = nzb_soil, nzt_soil
6272	local_pf(i,j,k) = t_soil_h%var_2d(k,m)
6273	ENDDO
6274	ENDDO
6275	ELSE
6276	IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN
6277	ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6278	t_soil_av = REAL( fill_value, KIND = wp )
6279	ENDIF
6280	DO i = nxl, nxr
6281	DO j = nys, nyn
6282	DO k = nzb_soil, nzt_soil
6283	local_pf(i,j,k) = t_soil_av(k,j,i)
6284	ENDDO
6285	ENDDO
6286	ENDDO
6287	ENDIF
6288
6289	nzb_do = nzb_soil
6290	nzt_do = nzt_soil
6291
6292	IF ( mode == 'xy' ) grid = 'zs'
6293
6294
6295	CASE DEFAULT
6296	found = .FALSE.
6297	grid = 'none'
6298
6299	END SELECT
6300
6301	END SUBROUTINE lsm_data_output_2d
6302
6303
6304	!------------------------------------------------------------------------------!
6305	!
6306	! Description:
6307	! ------------
6308	!> Subroutine defining 3D output variables
6309	!------------------------------------------------------------------------------!
6310	SUBROUTINE lsm_data_output_3d( av, variable, found, local_pf )
6311
6312
6313	USE indices
6314
6315
6316	IMPLICIT NONE
6317
6318	CHARACTER (LEN=*) :: variable !<
6319
6320	INTEGER(iwp) :: av !<
6321	INTEGER(iwp) :: i !<
6322	INTEGER(iwp) :: j !<
6323	INTEGER(iwp) :: k !<
6324	INTEGER(iwp) :: m !< running index
6325
6326	LOGICAL :: found !<
6327
6328	REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
6329
6330	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_soil:nzt_soil) :: local_pf !<
6331
6332
6333	found = .TRUE.
6334
6335
6336	SELECT CASE ( TRIM( variable ) )
6337	!
6338	!-- Requires 3D exchange
6339
6340	CASE ( 'm_soil' )
6341
6342	IF ( av == 0 ) THEN
6343	DO m = 1, surf_lsm_h%ns
6344	i = surf_lsm_h%i(m)
6345	j = surf_lsm_h%j(m)
6346	DO k = nzb_soil, nzt_soil
6347	local_pf(i,j,k) = m_soil_h%var_2d(k,m)
6348	ENDDO
6349	ENDDO
6350	ELSE
6351	IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN
6352	ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6353	m_soil_av = REAL( fill_value, KIND = wp )
6354	ENDIF
6355	DO i = nxl, nxr
6356	DO j = nys, nyn
6357	DO k = nzb_soil, nzt_soil
6358	local_pf(i,j,k) = m_soil_av(k,j,i)
6359	ENDDO
6360	ENDDO
6361	ENDDO
6362	ENDIF
6363
6364	CASE ( 't_soil' )
6365
6366	IF ( av == 0 ) THEN
6367	DO m = 1, surf_lsm_h%ns
6368	i = surf_lsm_h%i(m)
6369	j = surf_lsm_h%j(m)
6370	DO k = nzb_soil, nzt_soil
6371	local_pf(i,j,k) = t_soil_h%var_2d(k,m)
6372	ENDDO
6373	ENDDO
6374	ELSE
6375	IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN
6376	ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6377	t_soil_av = REAL( fill_value, KIND = wp )
6378	ENDIF
6379	DO i = nxl, nxr
6380	DO j = nys, nyn
6381	DO k = nzb_soil, nzt_soil
6382	local_pf(i,j,k) = t_soil_av(k,j,i)
6383	ENDDO
6384	ENDDO
6385	ENDDO
6386	ENDIF
6387
6388
6389	CASE DEFAULT
6390	found = .FALSE.
6391
6392	END SELECT
6393
6394
6395	END SUBROUTINE lsm_data_output_3d
6396
6397
6398	!------------------------------------------------------------------------------!
6399	!
6400	! Description:
6401	! ------------
6402	!> Write restart data for land surface model. It is necessary to write
6403	!> start_index and end_index several times.
6404	!------------------------------------------------------------------------------!
6405	SUBROUTINE lsm_wrd_local
6406
6407
6408	IMPLICIT NONE
6409
6410	CHARACTER (LEN=1) :: dum !< dummy to create correct string for creating variable string
6411	INTEGER(iwp) :: l !< index variable for surface orientation
6412
6413	CALL wrd_write_string( 'ns_h_on_file_lsm' )
6414	WRITE ( 14 ) surf_lsm_h%ns
6415
6416	CALL wrd_write_string( 'ns_v_on_file_lsm' )
6417	WRITE ( 14 ) surf_lsm_v(0:3)%ns
6418
6419
6420	IF ( ALLOCATED( c_liq_av ) ) THEN
6421	CALL wrd_write_string( 'c_liq_av' )
6422	WRITE ( 14 ) c_liq_av
6423	ENDIF
6424
6425	IF ( ALLOCATED( c_soil_av ) ) THEN
6426	CALL wrd_write_string( 'c_soil_av' )
6427	WRITE ( 14 ) c_soil_av
6428	ENDIF
6429
6430	IF ( ALLOCATED( c_veg_av ) ) THEN
6431	CALL wrd_write_string( 'c_veg_av' )
6432	WRITE ( 14 ) c_veg_av
6433	ENDIF
6434
6435	IF ( ALLOCATED( lai_av ) ) THEN
6436	CALL wrd_write_string( 'lai_av' )
6437	WRITE ( 14 ) lai_av
6438	ENDIF
6439
6440	IF ( ALLOCATED( m_liq_av ) ) THEN
6441	CALL wrd_write_string( 'm_liq_av' )
6442	WRITE ( 14 ) m_liq_av
6443	ENDIF
6444
6445	IF ( ALLOCATED( m_soil_av ) ) THEN
6446	CALL wrd_write_string( 'm_soil_av' )
6447	WRITE ( 14 ) m_soil_av
6448	ENDIF
6449
6450	IF ( ALLOCATED( qsws_liq_av ) ) THEN
6451	CALL wrd_write_string( 'qsws_liq_av' )
6452	WRITE ( 14 ) qsws_liq_av
6453	ENDIF
6454
6455	IF ( ALLOCATED( qsws_soil_av ) ) THEN
6456	CALL wrd_write_string( 'qsws_soil_av' )
6457	WRITE ( 14 ) qsws_soil_av
6458	ENDIF
6459
6460	IF ( ALLOCATED( qsws_veg_av ) ) THEN
6461	CALL wrd_write_string( 'qsws_veg_av' )
6462	WRITE ( 14 ) qsws_veg_av
6463	ENDIF
6464
6465	IF ( ALLOCATED( t_soil_av ) ) THEN
6466	CALL wrd_write_string( 't_soil_av' )
6467	WRITE ( 14 ) t_soil_av
6468	ENDIF
6469
6470	CALL wrd_write_string( 'lsm_start_index_h' )
6471	WRITE ( 14 ) surf_lsm_h%start_index
6472
6473	CALL wrd_write_string( 'lsm_end_index_h' )
6474	WRITE ( 14 ) surf_lsm_h%end_index
6475
6476	CALL wrd_write_string( 't_soil_h' )
6477	WRITE ( 14 ) t_soil_h%var_2d
6478
6479
6480
6481	DO l = 0, 3
6482
6483	CALL wrd_write_string( 'lsm_start_index_v' )
6484	WRITE ( 14 ) surf_lsm_v(l)%start_index
6485
6486	CALL wrd_write_string( 'lsm_end_index_v' )
6487	WRITE ( 14 ) surf_lsm_v(l)%end_index
6488
6489	WRITE( dum, '(I1)') l
6490
6491	CALL wrd_write_string( 't_soil_v(' // dum // ')' )
6492	WRITE ( 14 ) t_soil_v(l)%var_2d
6493
6494	ENDDO
6495
6496	CALL wrd_write_string( 'lsm_start_index_h' )
6497	WRITE ( 14 ) surf_lsm_h%start_index
6498
6499	CALL wrd_write_string( 'lsm_end_index_h' )
6500	WRITE ( 14 ) surf_lsm_h%end_index
6501
6502	CALL wrd_write_string( 'm_soil_h' )
6503	WRITE ( 14 ) m_soil_h%var_2d
6504
6505	DO l = 0, 3
6506
6507	CALL wrd_write_string( 'lsm_start_index_v' )
6508	WRITE ( 14 ) surf_lsm_v(l)%start_index
6509
6510	CALL wrd_write_string( 'lsm_end_index_v' )
6511	WRITE ( 14 ) surf_lsm_v(l)%end_index
6512
6513	WRITE( dum, '(I1)') l
6514
6515	CALL wrd_write_string( 'm_soil_v(' // dum // ')' )
6516	WRITE ( 14 ) m_soil_v(l)%var_2d
6517
6518	ENDDO
6519
6520	CALL wrd_write_string( 'lsm_start_index_h' )
6521	WRITE ( 14 ) surf_lsm_h%start_index
6522
6523	CALL wrd_write_string( 'lsm_end_index_h' )
6524	WRITE ( 14 ) surf_lsm_h%end_index
6525
6526	CALL wrd_write_string( 'm_liq_h' )
6527	WRITE ( 14 ) m_liq_h%var_1d
6528
6529	DO l = 0, 3
6530
6531	CALL wrd_write_string( 'lsm_start_index_v' )
6532	WRITE ( 14 ) surf_lsm_v(l)%start_index
6533
6534	CALL wrd_write_string( 'lsm_end_index_v' )
6535	WRITE ( 14 ) surf_lsm_v(l)%end_index
6536
6537	WRITE( dum, '(I1)') l
6538
6539	CALL wrd_write_string( 'm_liq_v(' // dum // ')' )
6540	WRITE ( 14 ) m_liq_v(l)%var_1d
6541
6542	ENDDO
6543
6544	CALL wrd_write_string( 'lsm_start_index_h' )
6545	WRITE ( 14 ) surf_lsm_h%start_index
6546
6547	CALL wrd_write_string( 'lsm_end_index_h' )
6548	WRITE ( 14 ) surf_lsm_h%end_index
6549
6550	CALL wrd_write_string( 't_surface_h' )
6551	WRITE ( 14 ) t_surface_h%var_1d
6552
6553	DO l = 0, 3
6554
6555	CALL wrd_write_string( 'lsm_start_index_v' )
6556	WRITE ( 14 ) surf_lsm_v(l)%start_index
6557
6558	CALL wrd_write_string( 'lsm_end_index_v' )
6559	WRITE ( 14 ) surf_lsm_v(l)%end_index
6560
6561	WRITE( dum, '(I1)') l
6562
6563	CALL wrd_write_string( 't_surface_v(' // dum // ')' )
6564	WRITE ( 14 ) t_surface_v(l)%var_1d
6565
6566	ENDDO
6567
6568
6569	END SUBROUTINE lsm_wrd_local
6570
6571
6572	!------------------------------------------------------------------------------!
6573	!
6574	! Description:
6575	! ------------
6576	!> Soubroutine reads lsm data from restart file(s)
6577	!------------------------------------------------------------------------------!
6578	SUBROUTINE lsm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
6579	nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc, &
6580	nys_on_file, tmp_2d, found )
6581
6582
6583	USE control_parameters
6584
6585	USE indices
6586
6587	USE pegrid
6588
6589
6590	IMPLICIT NONE
6591
6592	INTEGER(iwp) :: k !<
6593	INTEGER(iwp) :: l !< running index surface orientation
6594	INTEGER(iwp) :: ns_h_on_file_lsm !< number of horizontal surface elements (natural type) on file
6595	INTEGER(iwp) :: nxlc !<
6596	INTEGER(iwp) :: nxlf !<
6597	INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain
6598	INTEGER(iwp) :: nxrc !<
6599	INTEGER(iwp) :: nxrf !<
6600	INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain
6601	INTEGER(iwp) :: nync !<
6602	INTEGER(iwp) :: nynf !<
6603	INTEGER(iwp) :: nyn_on_file !< index of north boundary on former local domain
6604	INTEGER(iwp) :: nysc !<
6605	INTEGER(iwp) :: nysf !<
6606	INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain
6607
6608	INTEGER(iwp) :: ns_v_on_file_lsm(0:3) !< number of vertical surface elements (natural type) on file
6609
6610	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: start_index_on_file
6611	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: end_index_on_file
6612
6613	LOGICAL, INTENT(OUT) :: found
6614
6615	REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !<
6616
6617	REAL(wp), DIMENSION(nzb_soil:nzt_soil,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
6618
6619	TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_1d !< temporary 1D array containing the respective surface variable stored on file, horizontal surfaces
6620	TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_2d !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces
6621	TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_2d2 !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces
6622
6623	TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_1d !< temporary 1D array containing the respective surface variable stored on file, vertical surfaces
6624	TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces
6625	TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d2 !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces
6626
6627
6628	found = .TRUE.
6629
6630
6631	SELECT CASE ( restart_string(1:length) )
6632
6633	CASE ( 'ns_h_on_file_lsm' )
6634	IF ( k == 1 ) THEN
6635	READ ( 13 ) ns_h_on_file_lsm
6636
6637	IF ( ALLOCATED( tmp_walltype_h_1d%var_1d ) ) &
6638	DEALLOCATE( tmp_walltype_h_1d%var_1d )
6639	IF ( ALLOCATED( tmp_walltype_h_2d%var_2d ) ) &
6640	DEALLOCATE( tmp_walltype_h_2d%var_2d )
6641	IF ( ALLOCATED( tmp_walltype_h_2d2%var_2d ) ) &
6642	DEALLOCATE( tmp_walltype_h_2d2%var_2d )
6643
6644	!
6645	!-- Allocate temporary arrays to store surface data
6646	ALLOCATE( tmp_walltype_h_1d%var_1d(1:ns_h_on_file_lsm) )
6647	ALLOCATE( tmp_walltype_h_2d%var_2d(nzb_soil:nzt_soil+1, &
6648	1:ns_h_on_file_lsm) )
6649	ALLOCATE( tmp_walltype_h_2d2%var_2d(nzb_soil:nzt_soil, &
6650	1:ns_h_on_file_lsm) )
6651
6652	ENDIF
6653
6654	CASE ( 'ns_v_on_file_lsm' )
6655	IF ( k == 1 ) THEN
6656	READ ( 13 ) ns_v_on_file_lsm
6657
6658	DO l = 0, 3
6659	IF ( ALLOCATED( tmp_walltype_v_1d(l)%var_1d ) ) &
6660	DEALLOCATE( tmp_walltype_v_1d(l)%var_1d )
6661	IF ( ALLOCATED( tmp_walltype_v_2d(l)%var_2d ) ) &
6662	DEALLOCATE( tmp_walltype_v_2d(l)%var_2d )
6663	IF ( ALLOCATED( tmp_walltype_v_2d2(l)%var_2d ) ) &
6664	DEALLOCATE( tmp_walltype_v_2d2(l)%var_2d )
6665	ENDDO
6666
6667	!
6668	!-- Allocate temporary arrays to store surface data
6669	DO l = 0, 3
6670	ALLOCATE( tmp_walltype_v_1d(l) &
6671	%var_1d(1:ns_v_on_file_lsm(l)) )
6672	ALLOCATE( tmp_walltype_v_2d(l) &
6673	%var_2d(nzb_soil:nzt_soil+1, &
6674	1:ns_v_on_file_lsm(l)) )
6675	ALLOCATE( tmp_walltype_v_2d2(l) &
6676	%var_2d(nzb_soil:nzt_soil, &
6677	1:ns_v_on_file_lsm(l)) )
6678	ENDDO
6679
6680	ENDIF
6681
6682
6683	CASE ( 'c_liq_av' )
6684	IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN
6685	ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
6686	ENDIF
6687	IF ( k == 1 ) READ ( 13 ) tmp_2d
6688	c_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6689	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6690
6691	CASE ( 'c_soil_av' )
6692	IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN
6693	ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
6694	ENDIF
6695	IF ( k == 1 ) READ ( 13 ) tmp_2d
6696	c_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6697	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6698
6699	CASE ( 'c_veg_av' )
6700	IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN
6701	ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
6702	ENDIF
6703	IF ( k == 1 ) READ ( 13 ) tmp_2d
6704	c_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6705	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6706
6707	CASE ( 'lai_av' )
6708	IF ( .NOT. ALLOCATED( lai_av ) ) THEN
6709	ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
6710	ENDIF
6711	IF ( k == 1 ) READ ( 13 ) tmp_2d
6712	lai_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6713	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6714
6715	CASE ( 'm_liq_av' )
6716	IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN
6717	ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) )
6718	ENDIF
6719	IF ( k == 1 ) READ ( 13 ) tmp_2d
6720	m_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6721	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6722
6723	CASE ( 'm_soil_av' )
6724	IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN
6725	ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6726	ENDIF
6727	IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:)
6728	m_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6729	tmp_3d(nzb_soil:nzt_soil,nysf &
6730	-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6731
6732	CASE ( 'qsws_liq_av' )
6733	IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN
6734	ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) )
6735	ENDIF
6736	IF ( k == 1 ) READ ( 13 ) tmp_2d
6737	qsws_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6738	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6739	CASE ( 'qsws_soil_av' )
6740	IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN
6741	ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) )
6742	ENDIF
6743	IF ( k == 1 ) READ ( 13 ) tmp_2d
6744	qsws_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6745	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6746
6747	CASE ( 'qsws_veg_av' )
6748	IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN
6749	ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) )
6750	ENDIF
6751	IF ( k == 1 ) READ ( 13 ) tmp_2d
6752	qsws_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6753	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6754
6755	CASE ( 't_soil_av' )
6756	IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN
6757	ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
6758	ENDIF
6759	IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:)
6760	t_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
6761	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
6762
6763	CASE ( 'lsm_start_index_h', 'lsm_start_index_v' )
6764	IF ( k == 1 ) THEN
6765
6766	IF ( ALLOCATED( start_index_on_file ) ) &
6767	DEALLOCATE( start_index_on_file )
6768
6769	ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, &
6770	nxl_on_file:nxr_on_file) )
6771
6772	READ ( 13 ) start_index_on_file
6773
6774	ENDIF
6775
6776	CASE ( 'lsm_end_index_h', 'lsm_end_index_v' )
6777	IF ( k == 1 ) THEN
6778
6779	IF ( ALLOCATED( end_index_on_file ) ) &
6780	DEALLOCATE( end_index_on_file )
6781
6782	ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file, &
6783	nxl_on_file:nxr_on_file) )
6784
6785	READ ( 13 ) end_index_on_file
6786
6787	ENDIF
6788
6789	CASE ( 't_soil_h' )
6790
6791	IF ( k == 1 ) THEN
6792	IF ( .NOT. ALLOCATED( t_soil_h%var_2d ) ) &
6793	ALLOCATE( t_soil_h%var_2d(nzb_soil:nzt_soil+1, &
6794	1:surf_lsm_h%ns) )
6795	READ ( 13 ) tmp_walltype_h_2d%var_2d
6796	ENDIF
6797	CALL surface_restore_elements( &
6798	t_soil_h%var_2d, &
6799	tmp_walltype_h_2d%var_2d, &
6800	surf_lsm_h%start_index, &
6801	start_index_on_file, &
6802	end_index_on_file, &
6803	nxlc, nysc, &
6804	nxlf, nxrf, nysf, nynf, &
6805	nys_on_file, nyn_on_file, &
6806	nxl_on_file,nxr_on_file )
6807
6808	CASE ( 't_soil_v(0)' )
6809
6810	IF ( k == 1 ) THEN
6811	IF ( .NOT. ALLOCATED( t_soil_v(0)%var_2d ) ) &
6812	ALLOCATE( t_soil_v(0)%var_2d(nzb_soil:nzt_soil+1, &
6813	1:surf_lsm_v(0)%ns) )
6814	READ ( 13 ) tmp_walltype_v_2d(0)%var_2d
6815	ENDIF
6816	CALL surface_restore_elements( &
6817	t_soil_v(0)%var_2d, &
6818	tmp_walltype_v_2d(0)%var_2d, &
6819	surf_lsm_v(0)%start_index, &
6820	start_index_on_file, &
6821	end_index_on_file, &
6822	nxlc, nysc, &
6823	nxlf, nxrf, nysf, nynf, &
6824	nys_on_file, nyn_on_file, &
6825	nxl_on_file,nxr_on_file )
6826
6827	CASE ( 't_soil_v(1)' )
6828
6829	IF ( k == 1 ) THEN
6830	IF ( .NOT. ALLOCATED( t_soil_v(1)%var_2d ) ) &
6831	ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, &
6832	1:surf_lsm_v(1)%ns) )
6833	READ ( 13 ) tmp_walltype_v_2d(1)%var_2d
6834	ENDIF
6835	CALL surface_restore_elements( &
6836	t_soil_v(1)%var_2d, &
6837	tmp_walltype_v_2d(1)%var_2d, &
6838	surf_lsm_v(1)%start_index, &
6839	start_index_on_file, &
6840	end_index_on_file, &
6841	nxlc, nysc, &
6842	nxlf, nxrf, nysf, nynf, &
6843	nys_on_file, nyn_on_file, &
6844	nxl_on_file,nxr_on_file )
6845
6846	CASE ( 't_soil_v(2)' )
6847
6848	IF ( k == 1 ) THEN
6849	IF ( .NOT. ALLOCATED( t_soil_v(2)%var_2d ) ) &
6850	ALLOCATE( t_soil_v(2)%var_2d(nzb_soil:nzt_soil+1, &
6851	1:surf_lsm_v(2)%ns) )
6852	READ ( 13 ) tmp_walltype_v_2d(2)%var_2d
6853	ENDIF
6854	CALL surface_restore_elements( &
6855	t_soil_v(2)%var_2d, &
6856	tmp_walltype_v_2d(2)%var_2d, &
6857	surf_lsm_v(2)%start_index, &
6858	start_index_on_file, &
6859	end_index_on_file, &
6860	nxlc, nysc, &
6861	nxlf, nxrf, nysf, nynf, &
6862	nys_on_file, nyn_on_file, &
6863	nxl_on_file,nxr_on_file )
6864
6865	CASE ( 't_soil_v(3)' )
6866
6867	IF ( k == 1 ) THEN
6868	IF ( .NOT. ALLOCATED( t_soil_v(3)%var_2d ) ) &
6869	ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, &
6870	1:surf_lsm_v(3)%ns) )
6871	READ ( 13 ) tmp_walltype_v_2d(3)%var_2d
6872	ENDIF
6873	CALL surface_restore_elements( &
6874	t_soil_v(3)%var_2d, &
6875	tmp_walltype_v_2d(3)%var_2d, &
6876	surf_lsm_v(3)%start_index, &
6877	start_index_on_file, &
6878	end_index_on_file, &
6879	nxlc, nysc, &
6880	nxlf, nxrf, nysf, nynf, &
6881	nys_on_file, nyn_on_file, &
6882	nxl_on_file,nxr_on_file )
6883
6884	CASE ( 'm_soil_h' )
6885
6886	IF ( k == 1 ) THEN
6887	IF ( .NOT. ALLOCATED( m_soil_h%var_2d ) ) &
6888	ALLOCATE( m_soil_h%var_2d(nzb_soil:nzt_soil+1, &
6889	1:surf_lsm_h%ns) )
6890	READ ( 13 ) tmp_walltype_h_2d2%var_2d
6891	ENDIF
6892	CALL surface_restore_elements( &
6893	m_soil_h%var_2d, &
6894	tmp_walltype_h_2d2%var_2d, &
6895	surf_lsm_h%start_index, &
6896	start_index_on_file, &
6897	end_index_on_file, &
6898	nxlc, nysc, &
6899	nxlf, nxrf, nysf, nynf, &
6900	nys_on_file, nyn_on_file, &
6901	nxl_on_file,nxr_on_file )
6902
6903	CASE ( 'm_soil_v(0)' )
6904
6905	IF ( k == 1 ) THEN
6906	IF ( .NOT. ALLOCATED( m_soil_v(0)%var_2d ) ) &
6907	ALLOCATE( m_soil_v(0)%var_2d(nzb_soil:nzt_soil+1, &
6908	1:surf_lsm_v(0)%ns) )
6909	READ ( 13 ) tmp_walltype_v_2d2(0)%var_2d
6910	ENDIF
6911	CALL surface_restore_elements( &
6912	m_soil_v(0)%var_2d, &
6913	tmp_walltype_v_2d2(0)%var_2d, &
6914	surf_lsm_v(0)%start_index, &
6915	start_index_on_file, &
6916	end_index_on_file, &
6917	nxlc, nysc, &
6918	nxlf, nxrf, nysf, nynf, &
6919	nys_on_file, nyn_on_file, &
6920	nxl_on_file,nxr_on_file )
6921
6922	CASE ( 'm_soil_v(1)' )
6923
6924	IF ( k == 1 ) THEN
6925	IF ( .NOT. ALLOCATED( m_soil_v(1)%var_2d ) ) &
6926	ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, &
6927	1:surf_lsm_v(1)%ns) )
6928	READ ( 13 ) tmp_walltype_v_2d2(1)%var_2d
6929	ENDIF
6930	CALL surface_restore_elements( &
6931	m_soil_v(1)%var_2d, &
6932	tmp_walltype_v_2d2(1)%var_2d, &
6933	surf_lsm_v(1)%start_index, &
6934	start_index_on_file, &
6935	end_index_on_file, &
6936	nxlc, nysc, &
6937	nxlf, nxrf, nysf, nynf, &
6938	nys_on_file, nyn_on_file, &
6939	nxl_on_file,nxr_on_file )
6940
6941
6942	CASE ( 'm_soil_v(2)' )
6943
6944	IF ( k == 1 ) THEN
6945	IF ( .NOT. ALLOCATED( m_soil_v(2)%var_2d ) ) &
6946	ALLOCATE( m_soil_v(2)%var_2d(nzb_soil:nzt_soil+1, &
6947	1:surf_lsm_v(2)%ns) )
6948	READ ( 13 ) tmp_walltype_v_2d2(2)%var_2d
6949	ENDIF
6950	CALL surface_restore_elements( &
6951	m_soil_v(2)%var_2d, &
6952	tmp_walltype_v_2d2(2)%var_2d, &
6953	surf_lsm_v(2)%start_index, &
6954	start_index_on_file, &
6955	end_index_on_file, &
6956	nxlc, nysc, &
6957	nxlf, nxrf, nysf, nynf, &
6958	nys_on_file, nyn_on_file, &
6959	nxl_on_file,nxr_on_file )
6960
6961
6962	CASE ( 'm_soil_v(3)' )
6963
6964	IF ( k == 1 ) THEN
6965	IF ( .NOT. ALLOCATED( m_soil_v(3)%var_2d ) ) &
6966	ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, &
6967	1:surf_lsm_v(3)%ns) )
6968	READ ( 13 ) tmp_walltype_v_2d2(3)%var_2d
6969	ENDIF
6970	CALL surface_restore_elements( &
6971	m_soil_v(3)%var_2d, &
6972	tmp_walltype_v_2d2(3)%var_2d, &
6973	surf_lsm_v(3)%start_index, &
6974	start_index_on_file, &
6975	end_index_on_file, &
6976	nxlc, nysc, &
6977	nxlf, nxrf, nysf, nynf, &
6978	nys_on_file, nyn_on_file, &
6979	nxl_on_file,nxr_on_file )
6980
6981
6982	CASE ( 'm_liq_h' )
6983
6984	IF ( k == 1 ) THEN
6985	IF ( .NOT. ALLOCATED( m_liq_h%var_1d ) ) &
6986	ALLOCATE( m_liq_h%var_1d(1:surf_lsm_h%ns) )
6987	READ ( 13 ) tmp_walltype_h_1d%var_1d
6988	ENDIF
6989	CALL surface_restore_elements( &
6990	m_liq_h%var_1d, &
6991	tmp_walltype_h_1d%var_1d, &
6992	surf_lsm_h%start_index, &
6993	start_index_on_file, &
6994	end_index_on_file, &
6995	nxlc, nysc, &
6996	nxlf, nxrf, nysf, nynf, &
6997	nys_on_file, nyn_on_file, &
6998	nxl_on_file,nxr_on_file )
6999
7000
7001	CASE ( 'm_liq_v(0)' )
7002
7003	IF ( k == 1 ) THEN
7004	IF ( .NOT. ALLOCATED( m_liq_v(0)%var_1d ) ) &
7005	ALLOCATE( m_liq_v(0)%var_1d(1:surf_lsm_v(0)%ns) )
7006	READ ( 13 ) tmp_walltype_v_1d(0)%var_1d
7007	ENDIF
7008	CALL surface_restore_elements( &
7009	m_liq_v(0)%var_1d, &
7010	tmp_walltype_v_1d(0)%var_1d, &
7011	surf_lsm_v(0)%start_index, &
7012	start_index_on_file, &
7013	end_index_on_file, &
7014	nxlc, nysc, &
7015	nxlf, nxrf, nysf, nynf, &
7016	nys_on_file, nyn_on_file, &
7017	nxl_on_file,nxr_on_file )
7018
7019
7020	CASE ( 'm_liq_v(1)' )
7021
7022	IF ( k == 1 ) THEN
7023	IF ( .NOT. ALLOCATED( m_liq_v(1)%var_1d ) ) &
7024	ALLOCATE( m_liq_v(1)%var_1d(1:surf_lsm_v(1)%ns) )
7025	READ ( 13 ) tmp_walltype_v_1d(1)%var_1d
7026	ENDIF
7027	CALL surface_restore_elements( &
7028	m_liq_v(1)%var_1d, &
7029	tmp_walltype_v_1d(1)%var_1d, &
7030	surf_lsm_v(1)%start_index, &
7031	start_index_on_file, &
7032	end_index_on_file, &
7033	nxlc, nysc, &
7034	nxlf, nxrf, nysf, nynf, &
7035	nys_on_file, nyn_on_file, &
7036	nxl_on_file,nxr_on_file )
7037
7038
7039	CASE ( 'm_liq_v(2)' )
7040
7041	IF ( k == 1 ) THEN
7042	IF ( .NOT. ALLOCATED( m_liq_v(2)%var_1d ) ) &
7043	ALLOCATE( m_liq_v(2)%var_1d(1:surf_lsm_v(2)%ns) )
7044	READ ( 13 ) tmp_walltype_v_1d(2)%var_1d
7045	ENDIF
7046	CALL surface_restore_elements( &
7047	m_liq_v(2)%var_1d, &
7048	tmp_walltype_v_1d(2)%var_1d, &
7049	surf_lsm_v(2)%start_index, &
7050	start_index_on_file, &
7051	end_index_on_file, &
7052	nxlc, nysc, &
7053	nxlf, nxrf, nysf, nynf, &
7054	nys_on_file, nyn_on_file, &
7055	nxl_on_file,nxr_on_file )
7056
7057	CASE ( 'm_liq_v(3)' )
7058
7059	IF ( k == 1 ) THEN
7060	IF ( .NOT. ALLOCATED( m_liq_v(3)%var_1d ) ) &
7061	ALLOCATE( m_liq_v(3)%var_1d(1:surf_lsm_v(3)%ns) )
7062	READ ( 13 ) tmp_walltype_v_1d(3)%var_1d
7063	ENDIF
7064	CALL surface_restore_elements( &
7065	m_liq_v(3)%var_1d, &
7066	tmp_walltype_v_1d(3)%var_1d, &
7067	surf_lsm_v(3)%start_index, &
7068	start_index_on_file, &
7069	end_index_on_file, &
7070	nxlc, nysc, &
7071	nxlf, nxrf, nysf, nynf, &
7072	nys_on_file, nyn_on_file, &
7073	nxl_on_file,nxr_on_file )
7074
7075
7076	CASE ( 't_surface_h' )
7077
7078	IF ( k == 1 ) THEN
7079	IF ( .NOT. ALLOCATED( t_surface_h%var_1d ) ) &
7080	ALLOCATE( t_surface_h%var_1d(1:surf_lsm_h%ns) )
7081	READ ( 13 ) tmp_walltype_h_1d%var_1d
7082	ENDIF
7083	CALL surface_restore_elements( &
7084	t_surface_h%var_1d, &
7085	tmp_walltype_h_1d%var_1d, &
7086	surf_lsm_h%start_index, &
7087	start_index_on_file, &
7088	end_index_on_file, &
7089	nxlc, nysc, &
7090	nxlf, nxrf, nysf, nynf, &
7091	nys_on_file, nyn_on_file, &
7092	nxl_on_file,nxr_on_file )
7093
7094	CASE ( 't_surface_v(0)' )
7095
7096	IF ( k == 1 ) THEN
7097	IF ( .NOT. ALLOCATED( t_surface_v(0)%var_1d ) ) &
7098	ALLOCATE( t_surface_v(0)%var_1d(1:surf_lsm_v(0)%ns) )
7099	READ ( 13 ) tmp_walltype_v_1d(0)%var_1d
7100	ENDIF
7101	CALL surface_restore_elements( &
7102	t_surface_v(0)%var_1d, &
7103	tmp_walltype_v_1d(0)%var_1d, &
7104	surf_lsm_v(0)%start_index, &
7105	start_index_on_file, &
7106	end_index_on_file, &
7107	nxlc, nysc, &
7108	nxlf, nxrf, nysf, nynf, &
7109	nys_on_file, nyn_on_file, &
7110	nxl_on_file,nxr_on_file )
7111
7112	CASE ( 't_surface_v(1)' )
7113
7114	IF ( k == 1 ) THEN
7115	IF ( .NOT. ALLOCATED( t_surface_v(1)%var_1d ) ) &
7116	ALLOCATE( t_surface_v(1)%var_1d(1:surf_lsm_v(1)%ns) )
7117	READ ( 13 ) tmp_walltype_v_1d(1)%var_1d
7118	ENDIF
7119	CALL surface_restore_elements( &
7120	t_surface_v(1)%var_1d, &
7121	tmp_walltype_v_1d(1)%var_1d, &
7122	surf_lsm_v(1)%start_index, &
7123	start_index_on_file, &
7124	end_index_on_file, &
7125	nxlc, nysc, &
7126	nxlf, nxrf, nysf, nynf, &
7127	nys_on_file, nyn_on_file, &
7128	nxl_on_file,nxr_on_file )
7129
7130	CASE ( 't_surface_v(2)' )
7131
7132	IF ( k == 1 ) THEN
7133	IF ( .NOT. ALLOCATED( t_surface_v(2)%var_1d ) ) &
7134	ALLOCATE( t_surface_v(2)%var_1d(1:surf_lsm_v(2)%ns) )
7135	READ ( 13 ) tmp_walltype_v_1d(2)%var_1d
7136	ENDIF
7137	CALL surface_restore_elements( &
7138	t_surface_v(2)%var_1d, &
7139	tmp_walltype_v_1d(2)%var_1d, &
7140	surf_lsm_v(2)%start_index, &
7141	start_index_on_file, &
7142	end_index_on_file, &
7143	nxlc, nysc, &
7144	nxlf, nxrf, nysf, nynf, &
7145	nys_on_file, nyn_on_file, &
7146	nxl_on_file,nxr_on_file )
7147
7148	CASE ( 't_surface_v(3)' )
7149
7150	IF ( k == 1 ) THEN
7151	IF ( .NOT. ALLOCATED( t_surface_v(3)%var_1d ) ) &
7152	ALLOCATE( t_surface_v(3)%var_1d(1:surf_lsm_v(3)%ns) )
7153	READ ( 13 ) tmp_walltype_v_1d(3)%var_1d
7154	ENDIF
7155	CALL surface_restore_elements( &
7156	t_surface_v(3)%var_1d, &
7157	tmp_walltype_v_1d(3)%var_1d, &
7158	surf_lsm_v(3)%start_index, &
7159	start_index_on_file, &
7160	end_index_on_file, &
7161	nxlc, nysc, &
7162	nxlf, nxrf, nysf, nynf, &
7163	nys_on_file, nyn_on_file, &
7164	nxl_on_file,nxr_on_file )
7165
7166	CASE DEFAULT
7167
7168	found = .FALSE.
7169
7170	END SELECT
7171
7172
7173	END SUBROUTINE lsm_rrd_local
7174
7175	!------------------------------------------------------------------------------!
7176	! Description:
7177	! ------------
7178	!> Calculation of roughness length for open water (lakes, ocean). The
7179	!> parameterization follows Charnock (1955). Two different implementations
7180	!> are available: as in ECMWF-IFS (Beljaars 1994) or as in FLake (Subin et al.
7181	!> 2012)
7182	!------------------------------------------------------------------------------!
7183	SUBROUTINE calc_z0_water_surface
7184
7185	USE control_parameters, &
7186	ONLY: message_string, molecular_viscosity
7187
7188	IMPLICIT NONE
7189
7190	INTEGER(iwp) :: i !< running index
7191	INTEGER(iwp) :: j !< running index
7192	INTEGER(iwp) :: m !< running index
7193
7194	REAL(wp), PARAMETER :: alpha_ch = 0.018_wp !< Charnock constant (0.01-0.11). Use 0.01 for FLake and 0.018 for ECMWF
7195	! REAL(wp), PARAMETER :: pr_number = 0.71_wp !< molecular Prandtl number in the Charnock parameterization (differs from prandtl_number)
7196	! REAL(wp), PARAMETER :: sc_number = 0.66_wp !< molecular Schmidt number in the Charnock parameterization
7197	! REAL(wp) :: re_0 !< near-surface roughness Reynolds number
7198
7199	DO m = 1, surf_lsm_h%ns
7200
7201	i = surf_lsm_h%i(m)
7202	j = surf_lsm_h%j(m)
7203
7204	IF ( surf_lsm_h%water_surface(m) ) THEN
7205
7206	!
7207	!-- Disabled: FLake parameterization. Ideally, the Charnock
7208	!-- coefficient should depend on the water depth and the fetch
7209	!-- length
7210	! re_0 = z0(j,i) * us(j,i) / molecular_viscosity
7211	!
7212	! z0(j,i) = MAX( 0.1_wp * molecular_viscosity / us(j,i), &
7213	! alpha_ch * us(j,i) / g )
7214	!
7215	! z0h(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 3.2_wp ) )
7216	! z0q(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 4.2_wp ) )
7217
7218	!
7219	!-- Set minimum roughness length for u* > 0.2
7220	! IF ( us(j,i) > 0.2_wp ) THEN
7221	! z0h(j,i) = MAX( 1.0E-5_wp, z0h(j,i) )
7222	! z0q(j,i) = MAX( 1.0E-5_wp, z0q(j,i) )
7223	! ENDIF
7224
7225	!
7226	!-- ECMWF IFS model parameterization after Beljaars (1994). At low
7227	!-- wind speed, the sea surface becomes aerodynamically smooth and
7228	!-- the roughness scales with the viscosity. At high wind speed, the
7229	!-- Charnock relation is used.
7230	surf_lsm_h%z0(m) = ( 0.11_wp * molecular_viscosity / &
7231	surf_lsm_h%us(m) ) &
7232	+ ( alpha_ch * surf_lsm_h%us(m)**2 / g )
7233
7234	surf_lsm_h%z0h(m) = 0.40_wp * molecular_viscosity / &
7235	surf_lsm_h%us(m)
7236	surf_lsm_h%z0q(m) = 0.62_wp * molecular_viscosity / &
7237	surf_lsm_h%us(m)
7238
7239
7240	IF ( surf_lsm_h%z0(m) > 0.1_wp * surf_lsm_h%z_mo(m) ) THEN
7241
7242	surf_lsm_h%z0(m) = 0.1_wp * surf_lsm_h%z_mo(m)
7243
7244	WRITE( message_string, * ) 'z0 exceeds surface-layer height' //&
7245	' at horizontal sea surface and is ' // &
7246	'decreased appropriately at grid point (i,j) = ', &
7247	surf_lsm_h%i(m), surf_lsm_h%j(m)
7248	CALL message( 'land_surface_model_mod', 'PA0508', &
7249	0, 0, myid, 6, 0 )
7250	ENDIF
7251
7252	IF ( surf_lsm_h%z0h(m) >= 0.1_wp * surf_lsm_h%z_mo(m) ) THEN
7253
7254	surf_lsm_h%z0h(m) = 0.1_wp * surf_lsm_h%z_mo(m)
7255
7256	WRITE( message_string, * ) 'z0h exceeds surface-layer height'//&
7257	' at horizontal sea surface and is ' // &
7258	'decreased appropriately at grid point (i,j) = ', &
7259	surf_lsm_h%i(m), surf_lsm_h%j(m)
7260	CALL message( 'land_surface_model_mod', 'PA0508', &
7261	0, 0, myid, 6, 0 )
7262	ENDIF
7263
7264	IF ( surf_lsm_h%z0q(m) >= 0.1_wp * surf_lsm_h%z_mo(m) ) THEN
7265
7266	surf_lsm_h%z0q(m) = 0.1_wp * surf_lsm_h%z_mo(m)
7267
7268	WRITE( message_string, * ) 'z0q exceeds surface-layer height'//&
7269	' at horizontal sea surface and is ' // &
7270	'decreased appropriately at grid point (i,j) = ', &
7271	surf_lsm_h%i(m), surf_lsm_h%j(m)
7272	CALL message( 'land_surface_model_mod', 'PA0508', &
7273	0, 0, myid, 6, 0 )
7274	ENDIF
7275
7276
7277	ENDIF
7278	ENDDO
7279
7280	END SUBROUTINE calc_z0_water_surface
7281
7282
7283	!------------------------------------------------------------------------------!
7284	! Description:
7285	! ------------
7286	!> Vertical interpolation and extrapolation of 1D soil profile input from
7287	!> dynamic input file onto the numeric vertical soil grid.
7288	!------------------------------------------------------------------------------!
7289	SUBROUTINE interpolate_soil_profile( var, var_file, z_grid, z_file, &
7290	nzb_var, nzt_var, nzb_file, nzt_file )
7291
7292	IMPLICIT NONE
7293
7294	INTEGER(iwp) :: k !< running index z-direction file
7295	INTEGER(iwp) :: kk !< running index z-direction stretched model grid
7296	INTEGER(iwp) :: ku !< upper index bound along z-direction for varialbe from file
7297	INTEGER(iwp) :: nzb_var !< lower bound of final array
7298	INTEGER(iwp) :: nzt_var !< upper bound of final array
7299	INTEGER(iwp) :: nzb_file !< lower bound of file array
7300	INTEGER(iwp) :: nzt_file !< upper bound of file array
7301
7302	REAL(wp), DIMENSION(nzb_var:nzt_var) :: z_grid !< grid levels on numeric grid
7303	REAL(wp), DIMENSION(nzb_file:nzt_file) :: z_file !< grid levels on file grid
7304	REAL(wp), DIMENSION(nzb_var:nzt_var) :: var !< treated variable
7305	REAL(wp), DIMENSION(nzb_file:nzt_file) :: var_file !< temporary variable
7306
7307	ku = nzt_file
7308
7309	DO k = nzb_var, nzt_var
7310	!
7311	!-- Determine index on Inifor grid which is closest to the actual height
7312	kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
7313	!
7314	!-- If closest index on Inifor grid is smaller than top index,
7315	!-- interpolate the data
7316	IF ( kk < nzt_file ) THEN
7317	IF ( z_file(kk) - z_grid(k) <= 0.0_wp ) THEN
7318	var(k) = var_file(kk) + ( var_file(kk+1) - var_file(kk) ) / &
7319	( z_file(kk+1) - z_file(kk) ) * &
7320	( z_grid(k) - z_file(kk) )
7321
7322	ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp ) THEN
7323	var(k) = var_file(kk-1) + ( var_file(kk) - var_file(kk-1) ) / &
7324	( z_file(kk) - z_file(kk-1) ) * &
7325	( z_grid(k) - z_file(kk-1) )
7326	ENDIF
7327	!
7328	!-- Extrapolate if actual height is above the highest Inifor level by the last value
7329	ELSE
7330	var(k) = var_file(ku)
7331	ENDIF
7332
7333	ENDDO
7334
7335	END SUBROUTINE interpolate_soil_profile
7336
7337	!
7338	!-- Integrated stability function for heat and moisture
7339	FUNCTION psi_h( zeta )
7340
7341	USE kinds
7342
7343	IMPLICIT NONE
7344
7345	REAL(wp) :: psi_h !< Integrated similarity function result
7346	REAL(wp) :: zeta !< Stability parameter z/L
7347	REAL(wp) :: x !< dummy variable
7348
7349	REAL(wp), PARAMETER :: a = 1.0_wp !< constant
7350	REAL(wp), PARAMETER :: b = 0.66666666666_wp !< constant
7351	REAL(wp), PARAMETER :: c = 5.0_wp !< constant
7352	REAL(wp), PARAMETER :: d = 0.35_wp !< constant
7353	REAL(wp), PARAMETER :: c_d_d = c / d !< constant
7354	REAL(wp), PARAMETER :: bc_d_d = b * c / d !< constant
7355
7356
7357	IF ( zeta < 0.0_wp ) THEN
7358	x = SQRT( 1.0_wp - 16.0_wp * zeta )
7359	psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp )
7360	ELSE
7361	psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - (1.0_wp &
7362	+ 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d &
7363	+ 1.0_wp
7364	!
7365	!-- Old version for stable conditions (only valid for z/L < 0.5)
7366	!-- psi_h = - 5.0_wp * zeta
7367	ENDIF
7368
7369	END FUNCTION psi_h
7370
7371	END MODULE land_surface_model_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |