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

Last change on this file since 3685 was 3685, checked in by knoop, 6 years ago

Some interface calls moved to module_interface + cleanup

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