source: palm/trunk/SOURCE/surface_mod.f90 @ 2688

Last change on this file since 2688 was 2688, checked in by Giersch, 4 years ago

Error message PA0476 added. Bugfix in case of coupled runs.

  • Property svn:keywords set to Id
File size: 162.5 KB
Line 
1!> @file surface_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
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-2017 Leibniz Universitaet Hannover
18!
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! ------------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: surface_mod.f90 2688 2017-12-12 17:27:04Z Giersch $
28! Allocation and initialization of the latent heat flux (qsws) at the top of
29! the ocean domain in case of coupled runs. In addtion, a double if-query has
30! been removed. 
31!
32! 2638 2017-11-23 12:44:23Z raasch
33! bugfix for constant top momentumflux
34!
35! 2575 2017-10-24 09:57:58Z maronga
36! Pavement parameterization revised
37!
38! 2547 2017-10-16 12:41:56Z schwenkel
39! extended by cloud_droplets option
40!
41! 2508 2017-10-02 08:57:09Z suehring
42! Minor formatting adjustment
43!
44! 2478 2017-09-18 13:37:24Z suehring
45! Bugfixes in initializing model top
46!
47! 2378 2017-08-31 13:57:27Z suehring
48! Bugfix in write restart data
49!
50! 2339 2017-08-07 13:55:26Z gronemeier
51! corrected timestamp in header
52!
53! 2338 2017-08-07 12:15:38Z gronemeier
54! Modularize 1D model
55!
56! 2318 2017-07-20 17:27:44Z suehring
57! New function to obtain topography top index.
58!
59! 2317 2017-07-20 17:27:19Z suehring
60! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
61! includes two more prognostic equations for cloud drop concentration (nc) 
62! and cloud water content (qc).
63!
64! 2270 2017-06-09 12:18:47Z maronga
65! Parameters removed/added due to changes in the LSM
66!
67! 2269 2017-06-09 11:57:32Z suehring
68! Formatting and description adjustments
69!
70! 2256 2017-06-07 13:58:08Z suehring
71! Enable heating at downward-facing surfaces
72!
73! 2233 2017-05-30 18:08:54Z suehring
74! Initial revision
75!
76!
77! Description:
78! ------------
79!> Surface module defines derived data structures to treat surface-
80!> bounded grid cells. Three different types of surfaces are defined:
81!> default surfaces, natural surfaces, and urban surfaces. The module
82!> encompasses the allocation and initialization of surface arrays, and handles
83!> reading and writing restart data.
84!> In addition, a further derived data structure is defined, in order to set
85!> boundary conditions at surfaces. 
86!------------------------------------------------------------------------------!
87 MODULE surface_mod
88
89    USE arrays_3d,                                                             &
90        ONLY:  zu, zw, heatflux_input_conversion, waterflux_input_conversion,  &
91               momentumflux_input_conversion
92
93    USE control_parameters               
94
95    USE indices,                                                               &
96        ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt, wall_flags_0
97
98    USE grid_variables,                                                        &
99        ONLY:  dx, dy
100
101    USE kinds
102
103    USE model_1d_mod,                                                          &
104        ONLY:  rif1d, us1d, usws1d, vsws1d
105
106
107    IMPLICIT NONE
108
109!
110!-- Data type used to identify grid-points where horizontal boundary conditions
111!-- are applied
112    TYPE bc_type
113
114       INTEGER(iwp) :: ns                                  !< number of surface elements on the PE
115
116       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i       !< x-index linking to the PALM 3D-grid 
117       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j       !< y-index linking to the PALM 3D-grid   
118       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k       !< z-index linking to the PALM 3D-grid   
119
120       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index within surface data type for given (j,i)
121       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index   !< end index within surface data type for given (j,i) 
122
123    END TYPE bc_type
124!
125!-- Data type used to identify and treat surface-bounded grid points 
126    TYPE surf_type
127
128       INTEGER(iwp) :: ns                                  !< number of surface elements on the PE
129       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i       !< x-index linking to the PALM 3D-grid 
130       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j       !< y-index linking to the PALM 3D-grid   
131       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k       !< z-index linking to the PALM 3D-grid       
132
133       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  facing  !< Bit indicating surface orientation
134     
135       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< Start index within surface data type for given (j,i)
136       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index   !< End index within surface data type for given (j,i) 
137
138       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_mo      !< surface-layer height
139       REAL(wp), DIMENSION(:), ALLOCATABLE ::  uvw_abs   !< absolute surface-parallel velocity
140       REAL(wp), DIMENSION(:), ALLOCATABLE ::  us        !< friction velocity
141       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ts        !< scaling parameter temerature
142       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qs        !< scaling parameter humidity
143       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ss        !< scaling parameter passive scalar
144       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qcs       !< scaling parameter qc
145       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ncs       !< scaling parameter nc
146       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qrs       !< scaling parameter qr
147       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nrs       !< scaling parameter nr
148
149       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ol        !< Obukhov length
150       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rib       !< Richardson bulk number
151
152       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0        !< roughness length for momentum
153       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0h       !< roughness length for heat
154       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0q       !< roughness length for humidity
155
156       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt1       !< Specific humidity at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.)
157       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qv1       !< Potential temperature at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.)
158!
159!--    Define arrays for surface fluxes
160       REAL(wp), DIMENSION(:), ALLOCATABLE ::  usws      !< vertical momentum flux for u-component at horizontal surfaces
161       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vsws      !< vertical momentum flux for v-component at horizontal surfaces
162
163       REAL(wp), DIMENSION(:), ALLOCATABLE ::  shf       !< surface flux sensible heat
164       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws      !< surface flux latent heat
165       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ssws      !< surface flux passive scalar
166       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qcsws     !< surface flux qc
167       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ncsws     !< surface flux nc
168       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qrsws     !< surface flux qr
169       REAL(wp), DIMENSION(:), ALLOCATABLE ::  nrsws     !< surface flux nr
170       REAL(wp), DIMENSION(:), ALLOCATABLE ::  sasws     !< surface flux salinity
171!
172!--    Required for horizontal walls in production_e
173       REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_0       !< virtual velocity component (see production_e_init for further explanation)
174       REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_0       !< virtual velocity component (see production_e_init for further explanation)
175
176       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mom_flux_uv  !< momentum flux usvs and vsus at vertical surfaces (used in diffusion_u and diffusion_v)
177       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mom_flux_w   !< momentum flux wsus and wsvs at vertical surfaces (used in diffusion_w)
178       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  mom_flux_tke !< momentum flux usvs, vsus, wsus, wsvs at vertical surfaces at grid center (used in production_e)
179!
180!--    Variables required for LSM as well as for USM
181       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  pt_surface        !< skin-surface temperature
182       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rad_net_l         !< net radiation
183       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h          !< heat conductivity of soil (W/m/K)
184       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h_def      !< default heat conductivity of soil (W/m/K)   
185       
186       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  building_surface    !< flag parameter indicating that the surface element is covered by buildings (no LSM actions, not implemented yet)
187       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  pavement_surface    !< flag parameter for pavements
188       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  water_surface       !< flag parameter for water surfaces
189       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  vegetation_surface     !< flag parameter for natural land surfaces
190
191       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_liq               !< liquid water coverage (of vegetated area)
192       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_veg               !< vegetation coverage
193       REAL(wp), DIMENSION(:), ALLOCATABLE ::  f_sw_in             !< fraction of absorbed shortwave radiation by the surface layer (not implemented yet)
194       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ghf              !< ground heat flux
195       REAL(wp), DIMENSION(:), ALLOCATABLE ::  g_d                 !< coefficient for dependence of r_canopy on water vapour pressure deficit
196       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lai                 !< leaf area index
197       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surface_u    !< coupling between surface and soil (depends on vegetation type) (W/m2/K)
198       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surface_s    !< coupling between surface and soil (depends on vegetation type) (W/m2/K)
199       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_liq         !< surface flux of latent heat (liquid water portion)
200       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_soil        !< surface flux of latent heat (soil portion)
201       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qsws_veg         !< surface flux of latent heat (vegetation portion)
202       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_a                 !< aerodynamic resistance
203       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_canopy            !< canopy resistance
204       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_soil              !< soil resistance
205       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_soil_min          !< minimum soil resistance
206       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_s                 !< total surface resistance (combination of r_soil and r_canopy)
207       REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_canopy_min        !< minimum canopy (stomatal) resistance
208
209       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  alpha_vg          !< coef. of Van Genuchten
210       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_w          !< hydraulic diffusivity of soil (?)
211       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w           !< hydraulic conductivity of soil (W/m/K)
212       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gamma_w_sat       !< hydraulic conductivity at saturation
213       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  l_vg              !< coef. of Van Genuchten
214       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_fc              !< soil moisture at field capacity (m3/m3)
215       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_res             !< residual soil moisture
216       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_sat             !< saturation soil moisture (m3/m3)
217       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  m_wilt            !< soil moisture at permanent wilting point (m3/m3)
218       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  n_vg              !< coef. Van Genuchten 
219       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_total_def   !< default volumetric heat capacity of the (soil) layer (J/m3/K)
220       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_total       !< volumetric heat capacity of the actual soil matrix (J/m3/K)
221       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  root_fr           !< root fraction within the soil layers
222!
223!--    Urban surface variables
224       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  surface_types   !< array of types of wall parameters
225
226       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  isroof_surf         !< flag indication roof surfaces
227
228       REAL(wp), DIMENSION(:), ALLOCATABLE ::  albedo_surf         !< albedo of the surface
229       REAL(wp), DIMENSION(:), ALLOCATABLE ::  c_surface           !< heat capacity of the wall surface skin (J/m2/K)
230       REAL(wp), DIMENSION(:), ALLOCATABLE ::  emiss_surf          !< emissivity of the wall surface
231       REAL(wp), DIMENSION(:), ALLOCATABLE ::  lambda_surf         !< heat conductivity between air and surface (W/m2/K)
232       REAL(wp), DIMENSION(:), ALLOCATABLE ::  roughness_wall      !< roughness relative to concrete
233       REAL(wp), DIMENSION(:), ALLOCATABLE ::  thickness_wall      !< thickness of the wall, roof and soil layers
234
235       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsl           !< reflected shortwave radiation for local surface in i-th reflection
236       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutll           !< reflected + emitted longwave radiation for local surface in i-th reflection
237       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfhf              !< total radiation flux incoming to minus outgoing from local surface
238
239       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tt_surface_m        !< surface temperature tendency (K)
240       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf                !< kinematic wall heat flux of sensible heat (actually no longer needed)
241       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf_eb             !< wall heat flux of sensible heat in wall normal direction
242
243
244       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb             !< wall ground heat flux
245
246       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_in_sw           !< incoming shortwave radiation
247       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_out_sw          !< emitted shortwave radiation
248       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_in_lw           !< incoming longwave radiation
249       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_out_lw          !< emitted longwave radiation
250
251       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw            !< shortwave radiation falling to local surface including radiation from reflections
252       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw           !< total shortwave radiation outgoing from nonvirtual surfaces surfaces after all reflection
253       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw            !< longwave radiation falling to local surface including radiation from reflections
254       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw           !< total longwave radiation outgoing from nonvirtual surfaces surfaces after all reflection
255
256
257       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rho_c_wall        !< volumetric heat capacity of the material ( J m-3 K-1 ) (= 2.19E6)
258       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_wall           !< wall grid spacing (center-center)
259       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_wall          !< 1/dz_wall
260       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  dz_wall_stag      !< wall grid spacing (edge-edge)
261       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddz_wall_stag     !< 1/dz_wall_stag
262       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tt_wall_m         !< t_wall prognostic array
263       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw                !< wall layer depths (m)
264
265
266!-- arrays for time averages
267       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_net_av       !< average of rad_net_l
268       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinsw_av      !< average of sw radiation falling to local surface including radiation from reflections
269       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlw_av      !< average of lw radiation falling to local surface including radiation from reflections
270       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdir_av   !< average of direct sw radiation falling to local surface
271       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswdif_av   !< average of diffuse sw radiation from sky and model boundary falling to local surface
272       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwdif_av   !< average of diffuse lw radiation from sky and model boundary falling to local surface
273       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinswref_av   !< average of sw radiation falling to surface from reflections
274       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinlwref_av   !< average of lw radiation falling to surface from reflections
275       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutsw_av     !< average of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
276       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfoutlw_av     !< average of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
277       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfins_av       !< average of array of residua of sw radiation absorbed in surface after last reflection
278       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfinl_av       !< average of array of residua of lw radiation absorbed in surface after last reflection
279       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surfhf_av        !< average of total radiation flux incoming to minus outgoing from local surface 
280       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wghf_eb_av       !< average of wghf_eb
281       REAL(wp), DIMENSION(:), ALLOCATABLE ::  wshf_eb_av       !< average of wshf_eb
282       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_av        !< average of wall surface temperature (K)
283
284       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  t_wall_av      !< Average of t_wall
285
286    END TYPE surf_type
287
288    TYPE (bc_type), DIMENSION(0:1)           ::  bc_h        !< boundary condition data type, horizontal upward- and downward facing surfaces
289
290    TYPE (surf_type), DIMENSION(0:2), TARGET ::  surf_def_h  !< horizontal default surfaces (Up, Down, and Top)
291    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_def_v  !< vertical default surfaces (North, South, West, East)
292    TYPE (surf_type)                , TARGET ::  surf_lsm_h  !< horizontal natural land surfaces, so far only upward-facing
293    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_lsm_v  !< vertical land surfaces (North, South, West, East)
294    TYPE (surf_type)                , TARGET ::  surf_usm_h  !< horizontal urban surfaces, so far only upward-facing
295    TYPE (surf_type), DIMENSION(0:3), TARGET ::  surf_usm_v  !< vertical urban surfaces (North, South, West, East)
296
297    INTEGER(iwp) ::  ns_h_on_file(0:2)                       !< total number of horizontal surfaces with the same facing, required for writing restart data
298    INTEGER(iwp) ::  ns_v_on_file(0:3)                       !< total number of vertical surfaces with the same facing, required for writing restart data
299
300
301    SAVE
302
303    PRIVATE
304
305    INTERFACE get_topography_top_index
306       MODULE PROCEDURE get_topography_top_index
307    END  INTERFACE get_topography_top_index
308
309    INTERFACE init_bc
310       MODULE PROCEDURE init_bc
311    END INTERFACE init_bc
312
313    INTERFACE init_surfaces
314       MODULE PROCEDURE init_surfaces
315    END INTERFACE init_surfaces
316
317    INTERFACE init_surface_arrays
318       MODULE PROCEDURE init_surface_arrays
319    END INTERFACE init_surface_arrays
320
321    INTERFACE surface_read_restart_data
322       MODULE PROCEDURE surface_read_restart_data
323    END INTERFACE surface_read_restart_data
324
325    INTERFACE surface_write_restart_data
326       MODULE PROCEDURE surface_write_restart_data
327    END INTERFACE surface_write_restart_data
328
329    INTERFACE surface_last_actions
330       MODULE PROCEDURE surface_last_actions
331    END INTERFACE surface_last_actions
332
333!
334!-- Public variables
335    PUBLIC bc_h, ns_h_on_file, ns_v_on_file, surf_def_h, surf_def_v,           &
336           surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type
337!
338!-- Public subroutines and functions
339    PUBLIC get_topography_top_index, init_bc, init_surfaces,                   &
340           init_surface_arrays, surface_read_restart_data,                     &
341           surface_write_restart_data, surface_last_actions
342
343
344 CONTAINS
345
346!------------------------------------------------------------------------------!
347! Description:
348! ------------
349!> Initialize data type for setting boundary conditions at horizontal surfaces.
350!------------------------------------------------------------------------------!
351    SUBROUTINE init_bc
352
353       IMPLICIT NONE
354
355       INTEGER(iwp) ::  i         !<
356       INTEGER(iwp) ::  j         !<
357       INTEGER(iwp) ::  k         !<
358
359       INTEGER(iwp), DIMENSION(0:1) ::  num_h         !<
360       INTEGER(iwp), DIMENSION(0:1) ::  num_h_kji     !<
361       INTEGER(iwp), DIMENSION(0:1) ::  start_index_h !<
362
363!
364!--    First of all, count the number of upward- and downward-facing surfaces
365       num_h = 0
366       DO  i = nxlg, nxrg
367          DO  j = nysg, nyng
368             DO  k = nzb+1, nzt
369!
370!--             Check if current gridpoint belongs to the atmosphere
371                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
372!
373!--                Upward-facing
374                   IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )              &
375                      num_h(0) = num_h(0) + 1
376!
377!--                Downward-facing
378                   IF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )              &
379                      num_h(1) = num_h(1) + 1
380                ENDIF
381             ENDDO
382          ENDDO
383       ENDDO
384!
385!--    Save the number of surface elements
386       bc_h(0)%ns = num_h(0)
387       bc_h(1)%ns = num_h(1)
388!
389!--    ALLOCATE data type variables
390!--    Upward facing
391       ALLOCATE( bc_h(0)%i(1:bc_h(0)%ns) )
392       ALLOCATE( bc_h(0)%j(1:bc_h(0)%ns) )
393       ALLOCATE( bc_h(0)%k(1:bc_h(0)%ns) )
394       ALLOCATE( bc_h(0)%start_index(nysg:nyng,nxlg:nxrg) )
395       ALLOCATE( bc_h(0)%end_index(nysg:nyng,nxlg:nxrg)   )
396       bc_h(0)%start_index = 1
397       bc_h(0)%end_index   = 0
398!
399!--    Downward facing
400       ALLOCATE( bc_h(1)%i(1:bc_h(1)%ns) )
401       ALLOCATE( bc_h(1)%j(1:bc_h(1)%ns) )
402       ALLOCATE( bc_h(1)%k(1:bc_h(1)%ns) )
403       ALLOCATE( bc_h(1)%start_index(nysg:nyng,nxlg:nxrg) )
404       ALLOCATE( bc_h(1)%end_index(nysg:nyng,nxlg:nxrg)   )
405       bc_h(1)%start_index = 1
406       bc_h(1)%end_index   = 0
407!
408!--    Store the respective indices on data type
409       num_h(0:1)         = 1
410       start_index_h(0:1) = 1
411       DO  i = nxlg, nxrg
412          DO  j = nysg, nyng
413
414             num_h_kji(0:1) = 0
415             DO  k = nzb+1, nzt
416!
417!--             Check if current gridpoint belongs to the atmosphere
418                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
419!
420!--                Upward-facing
421                   IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN
422                      bc_h(0)%i(num_h(0)) = i
423                      bc_h(0)%j(num_h(0)) = j
424                      bc_h(0)%k(num_h(0)) = k
425                      num_h_kji(0)        = num_h_kji(0) + 1
426                      num_h(0)            = num_h(0) + 1
427                   ENDIF
428!
429!--                Downward-facing
430                   IF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )  THEN
431                      bc_h(1)%i(num_h(1)) = i
432                      bc_h(1)%j(num_h(1)) = j
433                      bc_h(1)%k(num_h(1)) = k
434                      num_h_kji(1)        = num_h_kji(1) + 1
435                      num_h(1)            = num_h(1) + 1
436                   ENDIF
437                ENDIF
438             ENDDO
439             bc_h(0)%start_index(j,i) = start_index_h(0)
440             bc_h(0)%end_index(j,i)   = bc_h(0)%start_index(j,i) + num_h_kji(0) - 1
441             start_index_h(0)         = bc_h(0)%end_index(j,i) + 1
442
443             bc_h(1)%start_index(j,i) = start_index_h(1)
444             bc_h(1)%end_index(j,i)   = bc_h(1)%start_index(j,i) + num_h_kji(1) - 1
445             start_index_h(1)         = bc_h(1)%end_index(j,i) + 1
446          ENDDO
447       ENDDO
448
449
450    END SUBROUTINE init_bc
451
452
453!------------------------------------------------------------------------------!
454! Description:
455! ------------
456!> Initialize horizontal and vertical surfaces. Counts the number of default-,
457!> natural and urban surfaces and allocates memory, respectively.
458!------------------------------------------------------------------------------!
459    SUBROUTINE init_surface_arrays
460
461       IMPLICIT NONE
462
463       INTEGER(iwp)                 ::  i         !< running index x-direction
464       INTEGER(iwp)                 ::  j         !< running index y-direction
465       INTEGER(iwp)                 ::  k         !< running index z-direction
466       INTEGER(iwp)                 ::  l         !< index variable for surface facing
467       INTEGER(iwp)                 ::  num_lsm_h !< number of horizontally-aligned natural surfaces
468       INTEGER(iwp)                 ::  num_usm_h !< number of horizontally-aligned urban surfaces
469
470       INTEGER(iwp), DIMENSION(0:2) ::  num_def_h !< number of horizontally-aligned default surfaces
471       INTEGER(iwp), DIMENSION(0:3) ::  num_def_v !< number of vertically-aligned default surfaces
472       INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v !< number of vertically-aligned natural surfaces
473       INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v !< number of vertically-aligned urban surfaces
474
475
476       num_def_h = 0
477       num_def_v = 0
478       num_lsm_h = 0
479       num_lsm_v = 0
480       num_usm_h = 0
481       num_usm_v = 0
482!
483!--    Count number of horizontal surfaces on local domain
484       DO  i = nxl, nxr
485          DO  j = nys, nyn
486             DO  k = nzb+1, nzt
487!
488!--             Check if current gridpoint belongs to the atmosphere
489                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
490!
491!--                Check if grid point adjoins to any upward-facing horizontal
492!--                surface, e.g. the Earth surface, plane roofs, or ceilings.
493                   IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN
494!
495!--                   Land-surface type
496                      IF ( land_surface )  THEN
497                         num_lsm_h    = num_lsm_h    + 1 
498!
499!--                   Urban surface tpye
500                      ELSEIF ( urban_surface )  THEN
501                         num_usm_h    = num_usm_h    + 1 
502!
503!--                   Default-surface type
504                      ELSE
505                         num_def_h(0) = num_def_h(0) + 1 
506                      ENDIF
507
508                   ENDIF
509!
510!--                Check for top-fluxes
511                   IF ( k == nzt  .AND.  use_top_fluxes )  THEN
512                      num_def_h(2) = num_def_h(2) + 1
513!
514!--                Check for any other downward-facing surface. So far only for
515!--                default surface type.
516                   ELSEIF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )  THEN
517                      num_def_h(1) = num_def_h(1) + 1
518                   ENDIF
519
520                ENDIF
521             ENDDO
522          ENDDO
523       ENDDO
524!
525!--    Count number of vertical surfaces on local domain
526       DO  i = nxl, nxr
527          DO  j = nys, nyn
528             DO  k = nzb+1, nzt
529                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
530!
531!--                Northward-facing
532                   IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) )  THEN
533                      IF ( urban_surface )  THEN
534                         num_usm_v(0) = num_usm_v(0) + 1 
535                      ELSEIF ( land_surface )  THEN
536                         num_lsm_v(0) = num_lsm_v(0) + 1 
537                      ELSE
538                         num_def_v(0) = num_def_v(0) + 1 
539                      ENDIF
540                   ENDIF
541!
542!--                Southward-facing
543                   IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )  THEN
544                      IF ( urban_surface )  THEN
545                         num_usm_v(1) = num_usm_v(1) + 1 
546                      ELSEIF ( land_surface )  THEN
547                         num_lsm_v(1) = num_lsm_v(1) + 1 
548                      ELSE
549                         num_def_v(1) = num_def_v(1) + 1 
550                      ENDIF
551                   ENDIF
552!
553!--                Eastward-facing
554                   IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) )  THEN
555                      IF ( urban_surface )  THEN
556                         num_usm_v(2) = num_usm_v(2) + 1 
557                      ELSEIF ( land_surface )  THEN
558                         num_lsm_v(2) = num_lsm_v(2) + 1 
559                      ELSE
560                         num_def_v(2) = num_def_v(2) + 1 
561                      ENDIF
562                   ENDIF
563!
564!--                Westward-facing
565                   IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )  THEN
566                      IF ( urban_surface )  THEN
567                         num_usm_v(3) = num_usm_v(3) + 1
568                      ELSEIF ( land_surface )  THEN
569                         num_lsm_v(3) = num_lsm_v(3) + 1 
570                      ELSE
571                         num_def_v(3) = num_def_v(3) + 1 
572                      ENDIF
573                   ENDIF
574                ENDIF
575             ENDDO
576          ENDDO
577       ENDDO
578
579!
580!--    Store number of surfaces per core.
581!--    Horizontal surface, default type, upward facing
582       surf_def_h(0)%ns = num_def_h(0)
583!
584!--    Horizontal surface, default type, downward facing
585       surf_def_h(1)%ns = num_def_h(1)
586!
587!--    Horizontal surface, default type, top downward facing
588       surf_def_h(2)%ns = num_def_h(2)
589!
590!--    Horizontal surface, natural type, so far only upward-facing
591       surf_lsm_h%ns    = num_lsm_h 
592!
593!--    Horizontal surface, urban type, so far only upward-facing
594       surf_usm_h%ns    = num_usm_h   
595!
596!--    Vertical surface, default type, northward facing
597       surf_def_v(0)%ns = num_def_v(0)
598!
599!--    Vertical surface, default type, southward facing
600       surf_def_v(1)%ns = num_def_v(1)
601!
602!--    Vertical surface, default type, eastward facing
603       surf_def_v(2)%ns = num_def_v(2)
604!
605!--    Vertical surface, default type, westward facing
606       surf_def_v(3)%ns = num_def_v(3)
607!
608!--    Vertical surface, natural type, northward facing
609       surf_lsm_v(0)%ns = num_lsm_v(0)
610!
611!--    Vertical surface, natural type, southward facing
612       surf_lsm_v(1)%ns = num_lsm_v(1)
613!
614!--    Vertical surface, natural type, eastward facing
615       surf_lsm_v(2)%ns = num_lsm_v(2)
616!
617!--    Vertical surface, natural type, westward facing
618       surf_lsm_v(3)%ns = num_lsm_v(3)
619!
620!--    Vertical surface, urban type, northward facing
621       surf_usm_v(0)%ns = num_usm_v(0)
622!
623!--    Vertical surface, urban type, southward facing
624       surf_usm_v(1)%ns = num_usm_v(1)
625!
626!--    Vertical surface, urban type, eastward facing
627       surf_usm_v(2)%ns = num_usm_v(2)
628!
629!--    Vertical surface, urban type, westward facing
630       surf_usm_v(3)%ns = num_usm_v(3)
631!
632!--    Allocate required attributes for horizontal surfaces - default type.
633!--    Upward-facing (l=0) and downward-facing (l=1).
634       DO  l = 0, 1
635          CALL allocate_surface_attributes_h ( surf_def_h(l), nys, nyn, nxl, nxr )
636       ENDDO
637!
638!--    Allocate required attributes for model top
639       CALL allocate_surface_attributes_h_top ( surf_def_h(2), nys, nyn, nxl, nxr )
640!
641!--    Allocate required attributes for horizontal surfaces - natural type.
642       CALL allocate_surface_attributes_h ( surf_lsm_h, nys, nyn, nxl, nxr )
643!
644!--    Allocate required attributes for horizontal surfaces - urban type.
645       CALL allocate_surface_attributes_h ( surf_usm_h, nys, nyn, nxl, nxr )
646
647!
648!--    Allocate required attributes for vertical surfaces.
649!--    Northward-facing (l=0), southward-facing (l=1), eastward-facing (l=2)
650!--    and westward-facing (l=3).
651!--    Default type.
652       DO  l = 0, 3
653          CALL allocate_surface_attributes_v ( surf_def_v(l), .FALSE.,         &
654                                               nys, nyn, nxl, nxr )
655       ENDDO
656!
657!--    Natural type
658       DO  l = 0, 3
659          CALL allocate_surface_attributes_v ( surf_lsm_v(l), .TRUE.,          &
660                                               nys, nyn, nxl, nxr )
661       ENDDO
662!
663!--    Urban type
664       DO  l = 0, 3
665          CALL allocate_surface_attributes_v ( surf_usm_v(l), .FALSE.,         &
666                                               nys, nyn, nxl, nxr )
667       ENDDO
668
669    END SUBROUTINE init_surface_arrays
670
671!------------------------------------------------------------------------------!
672! Description:
673! ------------
674!> Allocating memory for upward and downward-facing horizontal surface types,
675!> except for top fluxes.
676!------------------------------------------------------------------------------!
677    SUBROUTINE allocate_surface_attributes_h( surfaces,                        &
678                                              nys_l, nyn_l, nxl_l, nxr_l )
679
680       IMPLICIT NONE
681
682       INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
683       INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
684       INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
685       INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
686
687       TYPE(surf_type) ::  surfaces  !< respective surface type
688
689!
690!--    Allocate arrays for start and end index of horizontal surface type
691!--    for each (j,i)-grid point. This is required e.g. in diffion_x, which is
692!--    called for each (j,i). In order to find the location where the
693!--    respective flux is store within the surface-type, start- and end-
694!--    index are stored for each (j,i). For example, each (j,i) can have
695!--    several entries where fluxes for horizontal surfaces might be stored,
696!--    e.g. for overhanging structures where several upward-facing surfaces
697!--    might exist for given (j,i).
698!--    If no surface of respective type exist at current (j,i), set indicies
699!--    such that loop in diffusion routines will not be entered.
700       ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
701       ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l)   )
702       surfaces%start_index = 0
703       surfaces%end_index   = -1
704!
705!--    Indices to locate surface element
706       ALLOCATE ( surfaces%i(1:surfaces%ns)  )
707       ALLOCATE ( surfaces%j(1:surfaces%ns)  )
708       ALLOCATE ( surfaces%k(1:surfaces%ns)  )
709!
710!--    Surface-layer height
711       ALLOCATE ( surfaces%z_mo(1:surfaces%ns) )
712!
713!--    Surface orientation
714       ALLOCATE ( surfaces%facing(1:surfaces%ns) )
715!
716!--    Surface-parallel wind velocity
717       ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
718!      ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) )
719!
720!--    Roughness
721       ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
722       ALLOCATE ( surfaces%z0h(1:surfaces%ns) )
723       ALLOCATE ( surfaces%z0q(1:surfaces%ns) )
724!
725!--    Friction velocity
726       ALLOCATE ( surfaces%us(1:surfaces%ns) )
727!
728!--    Stability parameter
729       ALLOCATE ( surfaces%ol(1:surfaces%ns) )
730!
731!--    Bulk Richardson number
732       ALLOCATE ( surfaces%rib(1:surfaces%ns) )
733!
734!--    Vertical momentum fluxes of u and v
735       ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 
736       ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 
737!
738!--    Required in production_e
739       IF ( .NOT. constant_diffusion )  THEN   
740          ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 
741          ALLOCATE ( surfaces%v_0(1:surfaces%ns) )
742       ENDIF
743!
744!--    Characteristic temperature and surface flux of sensible heat
745       ALLOCATE ( surfaces%ts(1:surfaces%ns)  )   
746       ALLOCATE ( surfaces%shf(1:surfaces%ns) )   
747!
748!--    Characteristic humidity and surface flux of latent heat
749       IF ( humidity )  THEN
750          ALLOCATE ( surfaces%qs(1:surfaces%ns)   ) 
751          ALLOCATE ( surfaces%qsws(1:surfaces%ns) )     
752       ENDIF
753!
754!--    Characteristic scalar and surface flux of scalar
755       IF ( passive_scalar )  THEN
756          ALLOCATE ( surfaces%ss(1:surfaces%ns)   )   
757          ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 
758       ENDIF
759!
760!--    When cloud physics is used, arrays for storing potential temperature and
761!--    specific humidity at first grid level are required.
762       IF ( cloud_physics  .OR.  cloud_droplets )  THEN
763          ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
764          ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
765       ENDIF
766!
767!--       
768       IF ( cloud_physics .AND. microphysics_morrison)  THEN
769          ALLOCATE ( surfaces%qcs(1:surfaces%ns)   )
770          ALLOCATE ( surfaces%ncs(1:surfaces%ns)   )
771          ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
772          ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
773       ENDIF
774!
775!--       
776       IF ( cloud_physics .AND. microphysics_seifert)  THEN
777          ALLOCATE ( surfaces%qrs(1:surfaces%ns)   )
778          ALLOCATE ( surfaces%nrs(1:surfaces%ns)   )
779          ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
780          ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
781       ENDIF
782!
783!--    Salinity surface flux
784       IF ( ocean )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
785
786    END SUBROUTINE allocate_surface_attributes_h
787
788
789!------------------------------------------------------------------------------!
790! Description:
791! ------------
792!> Allocating memory for model-top fluxes 
793!------------------------------------------------------------------------------!
794    SUBROUTINE allocate_surface_attributes_h_top( surfaces,                    &
795                                                  nys_l, nyn_l, nxl_l, nxr_l )
796
797       IMPLICIT NONE
798
799       INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
800       INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
801       INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
802       INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
803
804       TYPE(surf_type) ::  surfaces !< respective surface type
805
806       ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
807       ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l)   )
808       surfaces%start_index = 0
809       surfaces%end_index   = -1
810!
811!--    Indices to locate surface (model-top) element
812       ALLOCATE ( surfaces%i(1:surfaces%ns)  )
813       ALLOCATE ( surfaces%j(1:surfaces%ns)  )
814       ALLOCATE ( surfaces%k(1:surfaces%ns)  )
815
816       IF ( .NOT. constant_diffusion )  THEN   
817          ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 
818          ALLOCATE ( surfaces%v_0(1:surfaces%ns) )
819       ENDIF
820!
821!--    Vertical momentum fluxes of u and v
822       ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 
823       ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 
824!
825!--    Sensible heat flux
826       ALLOCATE ( surfaces%shf(1:surfaces%ns) )   
827!
828!--    Latent heat flux
829       IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere')  THEN
830          ALLOCATE ( surfaces%qsws(1:surfaces%ns) )     
831       ENDIF
832!
833!--    Scalar flux
834       IF ( passive_scalar )  THEN
835          ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 
836       ENDIF
837!
838!--       
839       IF ( cloud_physics .AND. microphysics_morrison)  THEN
840          ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
841          ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
842       ENDIF
843!
844!--       
845       IF ( cloud_physics .AND. microphysics_seifert)  THEN
846          ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
847          ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
848       ENDIF
849!
850!--    Salinity flux
851       IF ( ocean )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
852
853    END SUBROUTINE allocate_surface_attributes_h_top
854
855!------------------------------------------------------------------------------!
856! Description:
857! ------------
858!> Allocating memory for vertical surface types.
859!------------------------------------------------------------------------------!
860    SUBROUTINE allocate_surface_attributes_v( surfaces, lsm,                   &
861                                              nys_l, nyn_l, nxl_l, nxr_l )
862
863       IMPLICIT NONE
864
865       INTEGER(iwp) ::  nyn_l  !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array
866       INTEGER(iwp) ::  nys_l  !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array
867       INTEGER(iwp) ::  nxl_l  !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array
868       INTEGER(iwp) ::  nxr_l  !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array
869
870       LOGICAL         ::  lsm      !< flag indicating data type of natural land surface
871
872       TYPE(surf_type) ::  surfaces !< respective surface type
873
874!
875!--    Allocate arrays for start and end index of vertical surface type
876!--    for each (j,i)-grid point. This is required in diffion_x, which is
877!--    called for each (j,i). In order to find the location where the
878!--    respective flux is store within the surface-type, start- and end-
879!--    index are stored for each (j,i). For example, each (j,i) can have
880!--    several entries where fluxes for vertical surfaces might be stored. 
881!--    In the flat case, where no vertical walls exit, set indicies such
882!--    that loop in diffusion routines will not be entered.
883       ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) )
884       ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l)   )
885       surfaces%start_index = 0
886       surfaces%end_index   = -1
887!
888!--    Indices to locate surface element.
889       ALLOCATE ( surfaces%i(1:surfaces%ns) )
890       ALLOCATE ( surfaces%j(1:surfaces%ns) )
891       ALLOCATE ( surfaces%k(1:surfaces%ns) )
892!
893!--    Surface-layer height
894       ALLOCATE ( surfaces%z_mo(1:surfaces%ns) )
895!
896!--    Surface orientation
897       ALLOCATE ( surfaces%facing(1:surfaces%ns) )
898!
899!--    Surface parallel wind velocity
900       ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
901!
902!--    Roughness
903       ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
904       ALLOCATE ( surfaces%z0h(1:surfaces%ns) )
905       ALLOCATE ( surfaces%z0q(1:surfaces%ns) )
906
907!
908!--    Friction velocity
909       ALLOCATE ( surfaces%us(1:surfaces%ns) )
910!
911!--    Allocate Obukhov length and bulk Richardson number. Only required
912!--    for natural land surfaces
913       IF ( lsm )  THEN
914          ALLOCATE( surfaces%ol(1:surfaces%ns)  ) 
915          ALLOCATE( surfaces%rib(1:surfaces%ns) ) 
916       ENDIF
917!
918!--    Allocate arrays for surface momentum fluxes for u and v. For u at north-
919!--    and south-facing surfaces, for v at east- and west-facing surfaces.
920       ALLOCATE ( surfaces%mom_flux_uv(1:surfaces%ns) )
921!
922!--    Allocate array for surface momentum flux for w - wsus and wsvs
923       ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) ) 
924!
925!--    Allocate array for surface momentum flux for subgrid-scale tke wsus and
926!--    wsvs; first index usvs or vsws, second index for wsus or wsvs, depending
927!--    on surface.
928       ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) ) 
929!
930!--    Characteristic temperature and surface flux of sensible heat
931       ALLOCATE ( surfaces%ts(1:surfaces%ns)  )   
932       ALLOCATE ( surfaces%shf(1:surfaces%ns) )   
933!
934!--    Characteristic humidity and surface flux of latent heat
935       IF ( humidity )  THEN
936          ALLOCATE ( surfaces%qs(1:surfaces%ns)   ) 
937          ALLOCATE ( surfaces%qsws(1:surfaces%ns) )     
938       ENDIF
939!
940!--    Characteristic scalar and surface flux of scalar
941       IF ( passive_scalar )  THEN
942          ALLOCATE ( surfaces%ss(1:surfaces%ns)   )   
943          ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 
944       ENDIF
945
946       IF ( cloud_physics .AND. microphysics_seifert)  THEN
947          ALLOCATE ( surfaces%qcs(1:surfaces%ns)   )
948          ALLOCATE ( surfaces%ncs(1:surfaces%ns)   )
949          ALLOCATE ( surfaces%qcsws(1:surfaces%ns) )
950          ALLOCATE ( surfaces%ncsws(1:surfaces%ns) )
951       ENDIF
952
953       IF ( cloud_physics .AND. microphysics_seifert)  THEN
954          ALLOCATE ( surfaces%qrs(1:surfaces%ns)   )
955          ALLOCATE ( surfaces%nrs(1:surfaces%ns)   )
956          ALLOCATE ( surfaces%qrsws(1:surfaces%ns) )
957          ALLOCATE ( surfaces%nrsws(1:surfaces%ns) )
958       ENDIF
959!
960!--    Salinity surface flux
961       IF ( ocean )  ALLOCATE ( surfaces%sasws(1:surfaces%ns) )
962
963    END SUBROUTINE allocate_surface_attributes_v
964
965!------------------------------------------------------------------------------!
966! Description:
967! ------------
968!> Initialize surface elements.
969!------------------------------------------------------------------------------!
970    SUBROUTINE init_surfaces
971
972       IMPLICIT NONE
973
974       INTEGER(iwp) ::  i         !< running index x-direction
975       INTEGER(iwp) ::  j         !< running index y-direction
976       INTEGER(iwp) ::  k         !< running index z-direction
977       INTEGER(iwp) ::  l         !< index variable used to distinguish surface facing
978       INTEGER(iwp) ::  m         !< running index surface elements
979
980       INTEGER(iwp)                 ::  start_index_lsm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal natural surfaces
981       INTEGER(iwp)                 ::  start_index_usm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal urban surfaces
982
983       INTEGER(iwp)                 ::  num_lsm_h     !< current number of horizontal surface element, natural type
984       INTEGER(iwp)                 ::  num_lsm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal natural surfaces
985       INTEGER(iwp)                 ::  num_usm_h     !< current number of horizontal surface element, urban type
986       INTEGER(iwp)                 ::  num_usm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal urban surfaces
987
988       INTEGER(iwp), DIMENSION(0:2) ::  num_def_h     !< current number of horizontal surface element, default type
989       INTEGER(iwp), DIMENSION(0:2) ::  num_def_h_kji !< dummy to determing local end index in surface type for given (j,i), for horizonal default surfaces
990       INTEGER(iwp), DIMENSION(0:2) ::  start_index_def_h !< dummy to determing local start index in surface type for given (j,i), for horizontal default surfaces
991     
992       INTEGER(iwp), DIMENSION(0:3) ::  num_def_v     !< current number of vertical surface element, default type
993       INTEGER(iwp), DIMENSION(0:3) ::  num_def_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical default surfaces
994       INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v     !< current number of vertical surface element, natural type
995       INTEGER(iwp), DIMENSION(0:3) ::  num_lsm_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical natural surfaces
996       INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v     !< current number of vertical surface element, urban type
997       INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical urban surfaces
998
999       INTEGER(iwp), DIMENSION(0:3) ::  start_index_def_v !< dummy to determing local start index in surface type for given (j,i), for vertical default surfaces
1000       INTEGER(iwp), DIMENSION(0:3) ::  start_index_lsm_v !< dummy to determing local start index in surface type for given (j,i), for vertical natural surfaces
1001       INTEGER(iwp), DIMENSION(0:3) ::  start_index_usm_v !< dummy to determing local start index in surface type for given (j,i), for vertical urban surfaces
1002
1003
1004!
1005!--    Initialize surface attributes, store indicies, surfaces orientation, etc.,
1006       num_def_h(0:2) = 1
1007       num_def_v(0:3) = 1
1008
1009       num_lsm_h      = 1
1010       num_lsm_v(0:3) = 1
1011
1012       num_usm_h      = 1
1013       num_usm_v(0:3) = 1
1014
1015       start_index_def_h(0:2) = 1
1016       start_index_def_v(0:3) = 1
1017
1018       start_index_lsm_h      = 1
1019       start_index_lsm_v(0:3) = 1
1020
1021       start_index_usm_h      = 1
1022       start_index_usm_v(0:3) = 1
1023
1024       DO  i = nxl, nxr
1025          DO  j = nys, nyn
1026
1027             num_def_h_kji = 0
1028             num_def_v_kji = 0
1029             num_lsm_h_kji = 0
1030             num_lsm_v_kji = 0
1031             num_usm_h_kji = 0
1032             num_usm_v_kji = 0
1033
1034             DO  k = nzb+1, nzt
1035!
1036!--             Check if current gridpoint belongs to the atmosphere
1037                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
1038!
1039!--                Upward-facing surface. Distinguish between differet surface types.
1040!--                To do, think about method to flag natural and non-natural
1041!--                surfaces. Only to ask for land_surface or urban surface
1042!--                is just a work-around.
1043                   IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN 
1044!
1045!--                   Natural surface type         
1046                      IF ( land_surface )  THEN
1047                         CALL initialize_horizontal_surfaces( k, j, i,         &
1048                                                              surf_lsm_h,      &
1049                                                              num_lsm_h,       &
1050                                                              num_lsm_h_kji,   &
1051                                                              .TRUE., .FALSE. ) 
1052!
1053!--                   Urban surface tpye
1054                      ELSEIF ( urban_surface )  THEN
1055                         CALL initialize_horizontal_surfaces( k, j, i,         &
1056                                                              surf_usm_h,      &
1057                                                              num_usm_h,       &
1058                                                              num_usm_h_kji,   &
1059                                                              .TRUE., .FALSE. ) 
1060!
1061!--                   Default surface type
1062                      ELSE
1063                         CALL initialize_horizontal_surfaces( k, j, i,         &
1064                                                              surf_def_h(0),   &
1065                                                              num_def_h(0),    &
1066                                                              num_def_h_kji(0),&
1067                                                              .TRUE., .FALSE. ) 
1068                      ENDIF
1069                   ENDIF 
1070!
1071!--                downward-facing surface, first, model top
1072                   IF ( k == nzt  .AND.  use_top_fluxes )  THEN
1073                      CALL initialize_top( k, j, i, surf_def_h(2),             &
1074                                           num_def_h(2), num_def_h_kji(2) )
1075!
1076!--                Check for any other downward-facing surface. So far only for
1077!--                default surface type.
1078                   ELSEIF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )  THEN
1079                      CALL initialize_horizontal_surfaces( k, j, i,            &
1080                                                           surf_def_h(1),      &
1081                                                           num_def_h(1),       &
1082                                                           num_def_h_kji(1),   &
1083                                                           .FALSE., .TRUE. )   
1084                   ENDIF
1085!
1086!--                Check for vertical walls and, if required, initialize it.
1087!                  Start with northward-facing surface.
1088                   IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) )  THEN
1089                      IF ( urban_surface )  THEN
1090                         CALL initialize_vertical_surfaces( 0, k, j, i,        &
1091                                                            surf_usm_v(0),     &
1092                                                            num_usm_v(0),      &
1093                                                            num_usm_v_kji(0),  &
1094                                                            .FALSE., .FALSE.,  &             
1095                                                            .FALSE., .TRUE. ) 
1096                      ELSEIF ( land_surface )  THEN
1097                         CALL initialize_vertical_surfaces( 0, k, j, i,        &
1098                                                            surf_lsm_v(0),     &
1099                                                            num_lsm_v(0),      &
1100                                                            num_lsm_v_kji(0),  &
1101                                                            .FALSE., .FALSE.,  &             
1102                                                            .FALSE., .TRUE. ) 
1103                      ELSE
1104                         CALL initialize_vertical_surfaces( 0, k, j, i,        &
1105                                                            surf_def_v(0),     &
1106                                                            num_def_v(0),      &
1107                                                            num_def_v_kji(0),  &
1108                                                            .FALSE., .FALSE.,  &             
1109                                                            .FALSE., .TRUE. ) 
1110                      ENDIF
1111                   ENDIF
1112!
1113!--                southward-facing surface
1114                   IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )  THEN
1115                      IF ( urban_surface )  THEN
1116                         CALL initialize_vertical_surfaces( 1, k, j, i,        &
1117                                                            surf_usm_v(1),     &
1118                                                            num_usm_v(1),      &
1119                                                            num_usm_v_kji(1),  &
1120                                                            .FALSE., .FALSE.,  &
1121                                                            .TRUE., .FALSE. )
1122                      ELSEIF ( land_surface )  THEN
1123                         CALL initialize_vertical_surfaces( 1, k, j, i,        &
1124                                                            surf_lsm_v(1),     &
1125                                                            num_lsm_v(1),      &
1126                                                            num_lsm_v_kji(1),  &
1127                                                            .FALSE., .FALSE.,  &
1128                                                            .TRUE., .FALSE. ) 
1129                      ELSE
1130                         CALL initialize_vertical_surfaces( 1, k, j, i,        &
1131                                                            surf_def_v(1),     &
1132                                                            num_def_v(1),      &
1133                                                            num_def_v_kji(1),  &
1134                                                            .FALSE., .FALSE.,  &
1135                                                            .TRUE., .FALSE. ) 
1136                      ENDIF
1137                   ENDIF
1138!
1139!--                eastward-facing surface
1140                   IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) )  THEN
1141                      IF ( urban_surface )  THEN
1142                         CALL initialize_vertical_surfaces( 2, k, j, i,        &
1143                                                            surf_usm_v(2),     &
1144                                                            num_usm_v(2),      &
1145                                                            num_usm_v_kji(2),  &
1146                                                            .TRUE., .FALSE.,   &
1147                                                            .FALSE., .FALSE. ) 
1148                      ELSEIF ( land_surface )  THEN
1149                         CALL initialize_vertical_surfaces( 2, k, j, i,        &
1150                                                            surf_lsm_v(2),     &
1151                                                            num_lsm_v(2),      &
1152                                                            num_lsm_v_kji(2),  &
1153                                                            .TRUE., .FALSE.,   &
1154                                                            .FALSE., .FALSE. ) 
1155                      ELSE
1156                         CALL initialize_vertical_surfaces( 2, k, j, i,        &
1157                                                            surf_def_v(2),     &
1158                                                            num_def_v(2),      &
1159                                                            num_def_v_kji(2),  &
1160                                                            .TRUE., .FALSE.,   &
1161                                                            .FALSE., .FALSE. ) 
1162                      ENDIF
1163                   ENDIF
1164!   
1165!--                westward-facing surface
1166                   IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )  THEN
1167                      IF ( urban_surface )  THEN
1168                         CALL initialize_vertical_surfaces( 3, k, j, i,        &
1169                                                            surf_usm_v(3),     &
1170                                                            num_usm_v(3),      &
1171                                                            num_usm_v_kji(3),  &
1172                                                           .FALSE., .TRUE.,    &
1173                                                           .FALSE., .FALSE. ) 
1174                      ELSEIF ( land_surface )  THEN
1175                         CALL initialize_vertical_surfaces( 3, k, j, i,        &
1176                                                            surf_lsm_v(3),     &
1177                                                            num_lsm_v(3),      &
1178                                                            num_lsm_v_kji(3),  &
1179                                                           .FALSE., .TRUE.,    &
1180                                                           .FALSE., .FALSE. ) 
1181                      ELSE
1182                         CALL initialize_vertical_surfaces( 3, k, j, i,        &
1183                                                            surf_def_v(3),     &
1184                                                            num_def_v(3),      &
1185                                                            num_def_v_kji(3),  &
1186                                                           .FALSE., .TRUE.,    &
1187                                                           .FALSE., .FALSE. ) 
1188                      ENDIF
1189                   ENDIF
1190                ENDIF
1191
1192 
1193             ENDDO
1194!
1195!--          Determine start- and end-index at grid point (j,i). Also, for
1196!--          horizontal surfaces more than 1 horizontal surface element can
1197!--          exist at grid point (j,i) if overhanging structures are present.
1198!--          Upward-facing surfaces
1199             surf_def_h(0)%start_index(j,i) = start_index_def_h(0)
1200             surf_def_h(0)%end_index(j,i)   = surf_def_h(0)%start_index(j,i) + &
1201                                                 num_def_h_kji(0) - 1
1202             start_index_def_h(0)           = surf_def_h(0)%end_index(j,i) + 1
1203!
1204!--          Downward-facing surfaces, except model top
1205             surf_def_h(1)%start_index(j,i) = start_index_def_h(1)                                                 
1206             surf_def_h(1)%end_index(j,i)   = surf_def_h(1)%start_index(j,i) + &
1207                                                 num_def_h_kji(1) - 1
1208             start_index_def_h(1)           = surf_def_h(1)%end_index(j,i) + 1
1209!
1210!--          Downward-facing surfaces -- model top fluxes
1211             surf_def_h(2)%start_index(j,i) = start_index_def_h(2)                                                 
1212             surf_def_h(2)%end_index(j,i)   = surf_def_h(2)%start_index(j,i) + &
1213                                                 num_def_h_kji(2) - 1
1214             start_index_def_h(2)           = surf_def_h(2)%end_index(j,i) + 1
1215!
1216!--          Horizontal natural land surfaces
1217             surf_lsm_h%start_index(j,i)    = start_index_lsm_h
1218             surf_lsm_h%end_index(j,i)      = surf_lsm_h%start_index(j,i) +    &
1219                                                 num_lsm_h_kji - 1
1220             start_index_lsm_h              = surf_lsm_h%end_index(j,i) + 1
1221!
1222!--          Horizontal urban surfaces
1223             surf_usm_h%start_index(j,i)    = start_index_usm_h
1224             surf_usm_h%end_index(j,i)      = surf_usm_h%start_index(j,i) +    &
1225                                                 num_usm_h_kji - 1
1226             start_index_usm_h              = surf_usm_h%end_index(j,i) + 1
1227
1228!
1229!--          Vertical surfaces - Default type
1230             surf_def_v(0)%start_index(j,i) = start_index_def_v(0)
1231             surf_def_v(1)%start_index(j,i) = start_index_def_v(1)
1232             surf_def_v(2)%start_index(j,i) = start_index_def_v(2)
1233             surf_def_v(3)%start_index(j,i) = start_index_def_v(3)
1234             surf_def_v(0)%end_index(j,i)   = start_index_def_v(0) +           & 
1235                                              num_def_v_kji(0) - 1
1236             surf_def_v(1)%end_index(j,i)   = start_index_def_v(1) +           &
1237                                              num_def_v_kji(1) - 1
1238             surf_def_v(2)%end_index(j,i)   = start_index_def_v(2) +           &
1239                                              num_def_v_kji(2) - 1
1240             surf_def_v(3)%end_index(j,i)   = start_index_def_v(3) +           &
1241                                              num_def_v_kji(3) - 1
1242             start_index_def_v(0)           = surf_def_v(0)%end_index(j,i) + 1
1243             start_index_def_v(1)           = surf_def_v(1)%end_index(j,i) + 1
1244             start_index_def_v(2)           = surf_def_v(2)%end_index(j,i) + 1
1245             start_index_def_v(3)           = surf_def_v(3)%end_index(j,i) + 1
1246!
1247!--          Natural type
1248             surf_lsm_v(0)%start_index(j,i) = start_index_lsm_v(0)
1249             surf_lsm_v(1)%start_index(j,i) = start_index_lsm_v(1)
1250             surf_lsm_v(2)%start_index(j,i) = start_index_lsm_v(2)
1251             surf_lsm_v(3)%start_index(j,i) = start_index_lsm_v(3)
1252             surf_lsm_v(0)%end_index(j,i)   = start_index_lsm_v(0) +           & 
1253                                              num_lsm_v_kji(0) - 1
1254             surf_lsm_v(1)%end_index(j,i)   = start_index_lsm_v(1) +           &
1255                                              num_lsm_v_kji(1) - 1
1256             surf_lsm_v(2)%end_index(j,i)   = start_index_lsm_v(2) +           &
1257                                              num_lsm_v_kji(2) - 1
1258             surf_lsm_v(3)%end_index(j,i)   = start_index_lsm_v(3) +           &
1259                                              num_lsm_v_kji(3) - 1
1260             start_index_lsm_v(0)           = surf_lsm_v(0)%end_index(j,i) + 1
1261             start_index_lsm_v(1)           = surf_lsm_v(1)%end_index(j,i) + 1
1262             start_index_lsm_v(2)           = surf_lsm_v(2)%end_index(j,i) + 1
1263             start_index_lsm_v(3)           = surf_lsm_v(3)%end_index(j,i) + 1
1264!
1265!--          Urban type
1266             surf_usm_v(0)%start_index(j,i) = start_index_usm_v(0)
1267             surf_usm_v(1)%start_index(j,i) = start_index_usm_v(1)
1268             surf_usm_v(2)%start_index(j,i) = start_index_usm_v(2)
1269             surf_usm_v(3)%start_index(j,i) = start_index_usm_v(3)
1270             surf_usm_v(0)%end_index(j,i)   = start_index_usm_v(0) +           & 
1271                                              num_usm_v_kji(0) - 1
1272             surf_usm_v(1)%end_index(j,i)   = start_index_usm_v(1) +           &
1273                                              num_usm_v_kji(1) - 1
1274             surf_usm_v(2)%end_index(j,i)   = start_index_usm_v(2) +           &
1275                                              num_usm_v_kji(2) - 1
1276             surf_usm_v(3)%end_index(j,i)   = start_index_usm_v(3) +           &
1277                                              num_usm_v_kji(3) - 1
1278             start_index_usm_v(0)           = surf_usm_v(0)%end_index(j,i) + 1
1279             start_index_usm_v(1)           = surf_usm_v(1)%end_index(j,i) + 1
1280             start_index_usm_v(2)           = surf_usm_v(2)%end_index(j,i) + 1
1281             start_index_usm_v(3)           = surf_usm_v(3)%end_index(j,i) + 1
1282
1283
1284          ENDDO
1285       ENDDO
1286
1287       CONTAINS
1288
1289!------------------------------------------------------------------------------!
1290! Description:
1291! ------------
1292!> Initialize horizontal surface elements, upward- and downward-facing.
1293!> Note, horizontal surface type alsw comprises model-top fluxes, which are,
1294!> initialized in a different routine.
1295!------------------------------------------------------------------------------!
1296          SUBROUTINE initialize_horizontal_surfaces( k, j, i, surf, num_h,     &
1297                                                     num_h_kji, upward_facing, &
1298                                                     downward_facing )       
1299
1300             IMPLICIT NONE
1301
1302             INTEGER(iwp)  ::  i                !< running index x-direction
1303             INTEGER(iwp)  ::  j                !< running index y-direction
1304             INTEGER(iwp)  ::  k                !< running index z-direction
1305             INTEGER(iwp)  ::  num_h            !< current number of surface element
1306             INTEGER(iwp)  ::  num_h_kji        !< dummy increment
1307
1308             LOGICAL       ::  upward_facing    !< flag indicating upward-facing surface
1309             LOGICAL       ::  downward_facing  !< flag indicating downward-facing surface
1310
1311             TYPE( surf_type ) :: surf          !< respective surface type
1312!
1313!--          Store indices of respective surface element
1314             surf%i(num_h) = i
1315             surf%j(num_h) = j
1316             surf%k(num_h) = k
1317!
1318!--          Surface orientation, bit 0 is set to 1 for upward-facing surfaces,
1319!--          bit 1 is for downward-facing surfaces.
1320             IF ( upward_facing   )  surf%facing(num_h) = IBSET( surf%facing(num_h), 0 )
1321             IF ( downward_facing )  surf%facing(num_h) = IBSET( surf%facing(num_h), 1 )
1322!
1323!--          Initialize surface-layer height
1324             IF ( upward_facing )  THEN
1325                surf%z_mo(num_h)  = zu(k) - zw(k-1)
1326             ELSE
1327                surf%z_mo(num_h)  = zw(k) - zu(k)
1328             ENDIF
1329 
1330             surf%z0(num_h)    = roughness_length
1331             surf%z0h(num_h)   = z0h_factor * roughness_length
1332             surf%z0q(num_h)   = z0h_factor * roughness_length         
1333!
1334!--          Initialization in case of 1D pre-cursor run
1335             IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )&
1336             THEN
1337                IF ( .NOT. constant_diffusion )  THEN
1338                   IF ( constant_flux_layer )  THEN
1339                      surf%ol(num_h)   = surf%z_mo(num_h) /                    &
1340                                            ( rif1d(nzb+1) + 1.0E-20_wp )
1341                      surf%us(num_h)   = us1d
1342                      surf%usws(num_h) = usws1d
1343                      surf%vsws(num_h) = vsws1d
1344                   ELSE
1345                      surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
1346                      surf%us(num_h)   = 0.0_wp
1347                      surf%usws(num_h) = 0.0_wp
1348                      surf%vsws(num_h) = 0.0_wp
1349                   ENDIF
1350                ELSE
1351                   surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
1352                   surf%us(num_h)   = 0.0_wp
1353                   surf%usws(num_h) = 0.0_wp
1354                   surf%vsws(num_h) = 0.0_wp
1355                ENDIF
1356!
1357!--          Initialization in case of constant profiles
1358             ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )&
1359             THEN
1360
1361                surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
1362!
1363!--             Very small number is required for calculation of Obukhov length
1364!--             at first timestep     
1365                surf%us(num_h)    = 1E-30_wp 
1366                surf%usws(num_h)  = 0.0_wp
1367                surf%vsws(num_h)  = 0.0_wp
1368       
1369             ENDIF
1370
1371             surf%rib(num_h)   = 0.0_wp 
1372             surf%uvw_abs(num_h) = 0.0_wp
1373
1374             IF ( .NOT. constant_diffusion )  THEN   
1375                surf%u_0(num_h)     = 0.0_wp 
1376                surf%v_0(num_h)     = 0.0_wp
1377             ENDIF
1378
1379             surf%ts(num_h)   = 0.0_wp
1380
1381             IF ( humidity )  THEN
1382                surf%qs(num_h)   = 0.0_wp
1383                IF ( cloud_physics .AND. microphysics_morrison)  THEN
1384                   surf%qcs(num_h) = 0.0_wp
1385                   surf%ncs(num_h) = 0.0_wp
1386   
1387                   surf%qcsws(num_h) = 0.0_wp
1388                   surf%ncsws(num_h) = 0.0_wp
1389
1390                ENDIF
1391                IF ( cloud_physics .AND. microphysics_seifert)  THEN
1392                   surf%qrs(num_h) = 0.0_wp
1393                   surf%nrs(num_h) = 0.0_wp
1394   
1395                   surf%qrsws(num_h) = 0.0_wp
1396                   surf%nrsws(num_h) = 0.0_wp
1397
1398                   surf%pt1(num_h) = 0.0_wp
1399                   surf%qv1(num_h) = 0.0_wp
1400
1401                ENDIF
1402             ENDIF
1403
1404             IF ( passive_scalar )  surf%ss(num_h) = 0.0_wp
1405!
1406!--          Inititalize surface fluxes of sensible and latent heat, as well as
1407!--          passive scalar
1408             IF ( use_surface_fluxes )  THEN
1409
1410                IF ( upward_facing )  THEN
1411                   IF ( constant_heatflux )  THEN
1412!   
1413!--                   Initialize surface heatflux. However, skip this for now if
1414!--                   if random_heatflux is set. This case, shf is initialized later.
1415                      IF ( .NOT. random_heatflux )  THEN
1416                         surf%shf(num_h) = surface_heatflux *               &
1417                                                 heatflux_input_conversion(nzb)
1418!
1419!--                      Check if surface heat flux might be replaced by
1420!--                      prescribed wall heatflux
1421                         IF ( k-1 /= 0 )  THEN
1422                            surf%shf(num_h) = wall_heatflux(0) *            &
1423                                                 heatflux_input_conversion(k-1)
1424                         ENDIF
1425!
1426!--                      Initialize shf with data from external file LSF_DATA. Will
1427!--                      be done directly in ls_foring_surf
1428!--                      Attention: Just a workaround, need to be revised!!!
1429                         IF ( large_scale_forcing .AND. lsf_surf )  THEN
1430!                             CALL ls_forcing_surf ( simulated_time )
1431!                             surf%shf(num_h) = shf(j,i) 
1432                         ENDIF
1433                      ENDIF
1434                   ELSE
1435                      surf%shf(num_h) = 0.0_wp
1436                   ENDIF
1437!
1438!--             Set heat-flux at downward-facing surfaces
1439                ELSE
1440                   surf%shf(num_h) = wall_heatflux(5) *                        &
1441                                             heatflux_input_conversion(k)
1442                ENDIF
1443
1444                IF ( humidity )  THEN
1445                   IF ( upward_facing )  THEN
1446                      IF ( constant_waterflux )  THEN
1447                         surf%qsws(num_h) = surface_waterflux *                &
1448                                                 waterflux_input_conversion(nzb)
1449                         IF ( k-1 /= 0 )  THEN
1450                            surf%qsws(num_h) = wall_humidityflux(0) *          &
1451                                                 waterflux_input_conversion(k-1)
1452                         ENDIF
1453                      ELSE
1454                         surf%qsws(num_h) = 0.0_wp
1455                      ENDIF
1456                   ELSE
1457                      surf%qsws(num_h) = wall_humidityflux(5) *                &
1458                                             heatflux_input_conversion(k)
1459                   ENDIF
1460                ENDIF
1461
1462                IF ( passive_scalar )  THEN
1463                   IF ( upward_facing )  THEN
1464                      IF ( constant_scalarflux )  THEN
1465                         surf%ssws(num_h) = surface_scalarflux
1466
1467                         IF ( k-1 /= 0 )                                       &
1468                            surf%ssws(num_h) = wall_scalarflux(0)
1469
1470                      ELSE
1471                         surf%ssws(num_h) = 0.0_wp
1472                      ENDIF
1473                   ELSE
1474                      surf%ssws(num_h) = wall_scalarflux(5)
1475                   ENDIF
1476                ENDIF
1477
1478                IF ( ocean )  THEN
1479                   IF ( upward_facing )  THEN
1480                      surf%sasws(num_h) = bottom_salinityflux
1481                   ELSE
1482                      surf%sasws(num_h) = 0.0_wp
1483                   ENDIF
1484                ENDIF
1485             ENDIF
1486!
1487!--          Increment surface indices
1488             num_h     = num_h + 1
1489             num_h_kji = num_h_kji + 1     
1490
1491
1492          END SUBROUTINE initialize_horizontal_surfaces
1493       
1494
1495!------------------------------------------------------------------------------!
1496! Description:
1497! ------------
1498!> Initialize model-top fluxes. Currently, only the heatflux and salinity flux
1499!> can be prescribed, latent flux is zero in this case!
1500!------------------------------------------------------------------------------!
1501          SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji )       
1502
1503             IMPLICIT NONE
1504
1505             INTEGER(iwp)  ::  i                !< running index x-direction
1506             INTEGER(iwp)  ::  j                !< running index y-direction
1507             INTEGER(iwp)  ::  k                !< running index z-direction
1508             INTEGER(iwp)  ::  num_h            !< current number of surface element
1509             INTEGER(iwp)  ::  num_h_kji        !< dummy increment
1510
1511             TYPE( surf_type ) :: surf          !< respective surface type
1512!
1513!--          Store indices of respective surface element
1514             surf%i(num_h) = i
1515             surf%j(num_h) = j
1516             surf%k(num_h) = k
1517!
1518!--          Initialize top heat flux
1519             IF ( constant_top_heatflux )                                      &
1520                surf%shf(num_h) = top_heatflux * heatflux_input_conversion(nzt+1)
1521!
1522!--          Initialization in case of a coupled model run
1523             IF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
1524                surf%shf(num_h) = 0.0_wp
1525                surf%qsws(num_h) = 0.0_wp
1526             ENDIF
1527!
1528!--          Prescribe latent heat flux at the top     
1529             IF ( humidity )  THEN
1530                surf%qsws(num_h) = 0.0_wp
1531                IF ( cloud_physics  .AND.  microphysics_morrison ) THEN
1532                   surf%ncsws(num_h) = 0.0_wp
1533                   surf%qcsws(num_h) = 0.0_wp
1534                ENDIF
1535                IF ( cloud_physics  .AND.  microphysics_seifert ) THEN
1536                   surf%nrsws(num_h) = 0.0_wp
1537                   surf%qrsws(num_h) = 0.0_wp
1538                ENDIF
1539             ENDIF
1540!
1541!--          Prescribe top scalar flux
1542             IF ( passive_scalar .AND. constant_top_scalarflux )               &
1543                surf%ssws(num_h) = top_scalarflux
1544!
1545!--          Prescribe top salinity flux
1546             IF ( ocean .AND. constant_top_salinityflux)                       &
1547                surf%sasws(num_h) = top_salinityflux
1548!
1549!--          Top momentum fluxes
1550             IF ( constant_top_momentumflux )  THEN
1551                surf%usws(num_h) = top_momentumflux_u *                        &
1552                                            momentumflux_input_conversion(nzt+1)
1553                surf%vsws(num_h) = top_momentumflux_v *                        &
1554                                            momentumflux_input_conversion(nzt+1)
1555             ENDIF
1556!
1557!--          Increment surface indices
1558             num_h     = num_h + 1
1559             num_h_kji = num_h_kji + 1     
1560
1561
1562          END SUBROUTINE initialize_top
1563
1564
1565!------------------------------------------------------------------------------!
1566! Description:
1567! ------------
1568!> Initialize vertical surface elements.
1569!------------------------------------------------------------------------------!
1570          SUBROUTINE initialize_vertical_surfaces( l, k, j, i, surf, num_v,    &
1571                                                num_v_kji, east_facing,        &
1572                                                west_facing, south_facing,     &
1573                                                north_facing )       
1574
1575             IMPLICIT NONE
1576
1577             INTEGER(iwp)  ::  component !<
1578             INTEGER(iwp)  ::  i               !< running index x-direction
1579             INTEGER(iwp)  ::  j               !< running index x-direction
1580             INTEGER(iwp)  ::  k               !< running index x-direction
1581             INTEGER(iwp)  ::  l               !< index variable for the surface type, indicating the facing
1582             INTEGER(iwp)  ::  num_v           !< current number of surface element
1583             INTEGER(iwp)  ::  num_v_kji       !< current number of surface element at (j,i)
1584
1585
1586             LOGICAL       ::  east_facing     !< flag indicating east-facing surfaces
1587             LOGICAL       ::  north_facing    !< flag indicating north-facing surfaces
1588             LOGICAL       ::  south_facing    !< flag indicating south-facing surfaces
1589             LOGICAL       ::  west_facing     !< flag indicating west-facing surfaces
1590
1591             TYPE( surf_type ) :: surf         !< respective surface type
1592
1593!
1594!--          Store indices of respective wall element
1595             surf%i(num_v)   = i
1596             surf%j(num_v)   = j
1597             surf%k(num_v)   = k
1598!
1599!--          Initialize surface-layer height, or more precisely, distance to surface
1600             IF ( north_facing  .OR.  south_facing )  THEN
1601                surf%z_mo(num_v)  = 0.5_wp * dy
1602             ELSE
1603                surf%z_mo(num_v)  = 0.5_wp * dx
1604             ENDIF
1605
1606             surf%facing(num_v)  = 0
1607!
1608!--          Surface orientation. Moreover, set component id to map wall_heatflux,
1609!--          etc., on surface type (further below)
1610             IF ( north_facing )  THEN
1611                surf%facing(num_v) = IBSET( surf%facing(num_v), 0 ) 
1612                component          = 4
1613             ENDIF
1614
1615             IF ( south_facing )  THEN
1616                surf%facing(num_v) = IBSET( surf%facing(num_v), 1 ) 
1617                component          = 3
1618             ENDIF
1619
1620             IF ( east_facing )  THEN
1621                surf%facing(num_v) = IBSET( surf%facing(num_v), 2 )
1622                component          = 2
1623             ENDIF
1624
1625             IF ( west_facing )  THEN
1626                surf%facing(num_v) = IBSET( surf%facing(num_v), 3 ) 
1627                component          = 1
1628             ENDIF
1629
1630 
1631             surf%z0(num_v)  = roughness_length
1632             surf%z0h(num_v) = z0h_factor * roughness_length
1633             surf%z0q(num_v) = z0h_factor * roughness_length
1634
1635             surf%us(num_v)  = 0.0_wp
1636!
1637!--          If required, initialize Obukhov length
1638             IF ( ALLOCATED( surf%ol ) )                                       &
1639                surf%ol(num_v) = surf%z_mo(num_v) / zeta_min
1640
1641             surf%uvw_abs(num_v)   = 0.0_wp
1642
1643             surf%mom_flux_uv(num_v) = 0.0_wp
1644             surf%mom_flux_w(num_v)  = 0.0_wp
1645             surf%mom_flux_tke(0:1,num_v) = 0.0_wp
1646
1647             surf%ts(num_v)    = 0.0_wp
1648             surf%shf(num_v)   = wall_heatflux(component)
1649
1650             IF ( humidity )  THEN
1651                surf%qs(num_v)   = 0.0_wp
1652                surf%qsws(num_v) = wall_humidityflux(component)
1653!
1654!--             Following wall fluxes are assumed to be zero
1655                IF ( cloud_physics .AND. microphysics_morrison)  THEN
1656                   surf%qcs(num_v) = 0.0_wp
1657                   surf%ncs(num_v) = 0.0_wp
1658   
1659                   surf%qcsws(num_v) = 0.0_wp
1660                   surf%ncsws(num_v) = 0.0_wp
1661                ENDIF
1662                IF ( cloud_physics .AND. microphysics_seifert)  THEN
1663                   surf%qrs(num_v) = 0.0_wp
1664                   surf%nrs(num_v) = 0.0_wp
1665   
1666                   surf%qrsws(num_v) = 0.0_wp
1667                   surf%nrsws(num_v) = 0.0_wp
1668                ENDIF
1669             ENDIF
1670
1671             IF ( passive_scalar )  THEN
1672                surf%ss(num_v)   = 0.0_wp
1673                surf%ssws(num_v) = wall_scalarflux(component)
1674             ENDIF
1675!
1676!--          So far, salinityflux at vertical surfaces is simply zero
1677!--          at the moment 
1678             IF ( ocean )  surf%sasws(num_v) = wall_salinityflux(component)
1679!
1680!--          Increment wall indices
1681             num_v                 = num_v + 1
1682             num_v_kji             = num_v_kji + 1
1683
1684          END SUBROUTINE initialize_vertical_surfaces
1685
1686    END SUBROUTINE init_surfaces
1687
1688
1689!------------------------------------------------------------------------------!
1690! Description:
1691! ------------
1692!> Determines topography-top index at given (j,i)-position. 
1693!------------------------------------------------------------------------------!
1694    FUNCTION get_topography_top_index( j, i, grid )
1695
1696       USE kinds
1697
1698       IMPLICIT NONE
1699
1700       CHARACTER(LEN=*) ::  grid                      !< flag to distinquish between staggered grids
1701       INTEGER(iwp)     ::  i                         !< grid index in x-dimension
1702       INTEGER(iwp)     ::  ibit                      !< bit position where topography information is stored on respective grid
1703       INTEGER(iwp)     ::  j                         !< grid index in y-dimension
1704       INTEGER(iwp)     ::  get_topography_top_index  !< topography top index
1705
1706       SELECT CASE ( TRIM( grid ) )
1707
1708          CASE ( 's'     )
1709             ibit = 12
1710          CASE ( 'u'     )
1711             ibit = 14
1712          CASE ( 'v'     )
1713             ibit = 16
1714          CASE ( 'w'     )
1715             ibit = 18
1716          CASE ( 's_out' )
1717             ibit = 24
1718          CASE ( 'u_out' )
1719             ibit = 26
1720          CASE ( 'v_out' )
1721             ibit = 27
1722          CASE ( 'w_out' )
1723             ibit = 28
1724          CASE DEFAULT
1725!
1726!--          Set default to scalar grid
1727             ibit = 12 
1728
1729       END SELECT
1730
1731       get_topography_top_index = MAXLOC(                                      &
1732                                     MERGE( 1, 0,                              &
1733                                            BTEST( wall_flags_0(:,j,i), ibit ) &
1734                                          ), DIM = 1                           &
1735                                        ) - 1
1736
1737       RETURN
1738
1739    END FUNCTION get_topography_top_index
1740
1741!------------------------------------------------------------------------------!
1742! Description:
1743! ------------
1744!> Gathers all surface elements with the same facing (but possibly different
1745!> type) onto a surface type, and writes binary data into restart files.
1746!------------------------------------------------------------------------------!
1747    SUBROUTINE surface_write_restart_data
1748
1749       IMPLICIT NONE
1750
1751       CHARACTER(LEN=1)             ::  dum  !< dummy string to create output-variable name
1752
1753       INTEGER(iwp)                 ::  i    !< running index x-direction
1754       INTEGER(iwp)                 ::  j    !< running index y-direction
1755       INTEGER(iwp)                 ::  l    !< index surface type orientation
1756       INTEGER(iwp)                 ::  m    !< running index for surface elements on individual surface array
1757       INTEGER(iwp), DIMENSION(0:3) ::  mm   !< running index for surface elements on gathered surface array
1758
1759       TYPE(surf_type), DIMENSION(0:2) ::  surf_h !< gathered horizontal surfaces, contains all surface types
1760       TYPE(surf_type), DIMENSION(0:3) ::  surf_v !< gathered vertical surfaces, contains all surface types
1761
1762!
1763!--    Determine total number of horizontal and vertical surface elements before
1764!--    writing var_list
1765       CALL surface_last_actions
1766!
1767!--    Count number of grid points with same facing and allocate attributes respectively
1768!--    Horizontal upward facing
1769       surf_h(0)%ns = ns_h_on_file(0)
1770       CALL allocate_surface_attributes_h( surf_h(0), nys, nyn, nxl, nxr )
1771!
1772!--    Horizontal downward facing
1773       surf_h(1)%ns = ns_h_on_file(1)
1774       CALL allocate_surface_attributes_h( surf_h(1), nys, nyn, nxl, nxr )
1775!
1776!--    Model top
1777       surf_h(2)%ns = ns_h_on_file(2)
1778       CALL allocate_surface_attributes_h_top( surf_h(2), nys, nyn, nxl, nxr )
1779!
1780!--    Vertical surfaces
1781       DO  l = 0, 3
1782          surf_v(l)%ns = ns_v_on_file(l)
1783          CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,              &
1784                                              nys, nyn, nxl, nxr )
1785       ENDDO
1786!
1787!--    In the following, gather data from surfaces elements with the same
1788!--    facing (but possibly differt type) on 1 data-type array.
1789       mm(0:2) = 1
1790       DO  l = 0, 2
1791          DO  i = nxl, nxr
1792             DO  j = nys, nyn
1793                DO  m = surf_def_h(l)%start_index(j,i),                        &
1794                        surf_def_h(l)%end_index(j,i)
1795                   IF ( ALLOCATED( surf_def_h(l)%us ) )                        &
1796                      surf_h(l)%us(mm(l))      = surf_def_h(l)%us(m)
1797                   IF ( ALLOCATED( surf_def_h(l)%ts ) )                        &
1798                      surf_h(l)%ts(mm(l))      = surf_def_h(l)%ts(m)
1799                   IF ( ALLOCATED( surf_def_h(l)%qs ) )                        &
1800                      surf_h(l)%qs(mm(l))      = surf_def_h(l)%qs(m)
1801                   IF ( ALLOCATED( surf_def_h(l)%ss ) )                        &
1802                      surf_h(l)%ss(mm(l))      = surf_def_h(l)%ss(m)
1803                   IF ( ALLOCATED( surf_def_h(l)%qcs ) )                       &
1804                      surf_h(l)%qcs(mm(l))     = surf_def_h(l)%qcs(m)
1805                   IF ( ALLOCATED( surf_def_h(l)%ncs ) )                       &
1806                      surf_h(l)%ncs(mm(l))     = surf_def_h(l)%ncs(m)
1807                   IF ( ALLOCATED( surf_def_h(l)%qrs ) )                       &
1808                      surf_h(l)%qrs(mm(l))     = surf_def_h(l)%qrs(m)
1809                   IF ( ALLOCATED( surf_def_h(l)%nrs ) )                       &
1810                      surf_h(l)%nrs(mm(l))     = surf_def_h(l)%nrs(m)
1811                   IF ( ALLOCATED( surf_def_h(l)%ol ) )                        &
1812                      surf_h(l)%ol(mm(l))      = surf_def_h(l)%ol(m)
1813                   IF ( ALLOCATED( surf_def_h(l)%rib ) )                       &
1814                      surf_h(l)%rib(mm(l))     = surf_def_h(l)%rib(m)
1815                   IF ( ALLOCATED( surf_def_h(l)%usws ) )                      &
1816                      surf_h(l)%usws(mm(l))    = surf_def_h(l)%usws(m)
1817                   IF ( ALLOCATED( surf_def_h(l)%vsws ) )                      &
1818                      surf_h(l)%vsws(mm(l))    = surf_def_h(l)%vsws(m)
1819                   IF ( ALLOCATED( surf_def_h(l)%shf ) )                       &
1820                      surf_h(l)%shf(mm(l))     = surf_def_h(l)%shf(m)
1821                   IF ( ALLOCATED( surf_def_h(l)%qsws ) )                      &
1822                      surf_h(l)%qsws(mm(l))    = surf_def_h(l)%qsws(m)
1823                   IF ( ALLOCATED( surf_def_h(l)%ssws ) )                      &
1824                      surf_h(l)%ssws(mm(l))    = surf_def_h(l)%ssws(m)
1825                   IF ( ALLOCATED( surf_def_h(l)%ncsws ) )                     &
1826                      surf_h(l)%ncsws(mm(l))   = surf_def_h(l)%ncsws(m)
1827                   IF ( ALLOCATED( surf_def_h(l)%nrsws ) )                     &
1828                      surf_h(l)%nrsws(mm(l))   = surf_def_h(l)%nrsws(m)
1829                   IF ( ALLOCATED( surf_def_h(l)%sasws ) )                     &
1830                      surf_h(l)%sasws(mm(l))   = surf_def_h(l)%sasws(m)
1831               
1832                   mm(l) = mm(l) + 1
1833                ENDDO
1834
1835                IF ( l == 0 )  THEN
1836                   DO  m = surf_lsm_h%start_index(j,i),                        &
1837                           surf_lsm_h%end_index(j,i)
1838                      IF ( ALLOCATED( surf_lsm_h%us ) )                        &
1839                         surf_h(0)%us(mm(0))      = surf_lsm_h%us(m)
1840                      IF ( ALLOCATED( surf_lsm_h%ts ) )                        &
1841                         surf_h(0)%ts(mm(0))      = surf_lsm_h%ts(m)
1842                      IF ( ALLOCATED( surf_lsm_h%qs ) )                        &
1843                         surf_h(0)%qs(mm(0))      = surf_lsm_h%qs(m)
1844                      IF ( ALLOCATED( surf_lsm_h%ss ) )                        &
1845                         surf_h(0)%ss(mm(0))      = surf_lsm_h%ss(m)
1846                      IF ( ALLOCATED( surf_lsm_h%qcs ) )                       &
1847                         surf_h(0)%qcs(mm(0))     = surf_lsm_h%qcs(m)
1848                      IF ( ALLOCATED( surf_lsm_h%ncs ) )                       &
1849                         surf_h(0)%ncs(mm(0))     = surf_lsm_h%ncs(m)
1850                      IF ( ALLOCATED( surf_lsm_h%qrs ) )                       &
1851                         surf_h(0)%qrs(mm(0))     = surf_lsm_h%qrs(m)
1852                      IF ( ALLOCATED( surf_lsm_h%nrs ) )                       &
1853                         surf_h(0)%nrs(mm(0))     = surf_lsm_h%nrs(m)
1854                      IF ( ALLOCATED( surf_lsm_h%ol ) )                        &
1855                         surf_h(0)%ol(mm(0))      = surf_lsm_h%ol(m)
1856                      IF ( ALLOCATED( surf_lsm_h%rib ) )                       &
1857                         surf_h(0)%rib(mm(0))     = surf_lsm_h%rib(m)
1858                      IF ( ALLOCATED( surf_lsm_h%usws ) )                      &
1859                         surf_h(0)%usws(mm(0))    = surf_lsm_h%usws(m)
1860                      IF ( ALLOCATED( surf_lsm_h%vsws ) )                      &
1861                         surf_h(0)%vsws(mm(0))    = surf_lsm_h%vsws(m)
1862                      IF ( ALLOCATED( surf_lsm_h%shf ) )                       &
1863                         surf_h(0)%shf(mm(0))     = surf_lsm_h%shf(m)
1864                      IF ( ALLOCATED( surf_lsm_h%qsws ) )                      &
1865                         surf_h(0)%qsws(mm(0))    = surf_lsm_h%qsws(m)
1866                      IF ( ALLOCATED( surf_lsm_h%ssws ) )                      &
1867                         surf_h(0)%ssws(mm(0))    = surf_lsm_h%ssws(m)
1868                      IF ( ALLOCATED( surf_lsm_h%ncsws ) )                     &
1869                         surf_h(0)%ncsws(mm(0))   = surf_lsm_h%ncsws(m)
1870                      IF ( ALLOCATED( surf_lsm_h%nrsws ) )                     &
1871                         surf_h(0)%nrsws(mm(0))   = surf_lsm_h%nrsws(m)
1872                      IF ( ALLOCATED( surf_lsm_h%sasws ) )                     &
1873                        surf_h(0)%sasws(mm(0))   = surf_lsm_h%sasws(m)
1874               
1875                      mm(0) = mm(0) + 1
1876             
1877                   ENDDO
1878
1879                   DO  m = surf_usm_h%start_index(j,i),                        &
1880                           surf_usm_h%end_index(j,i)
1881                      IF ( ALLOCATED( surf_usm_h%us ) )                        &
1882                         surf_h(0)%us(mm(0))      = surf_usm_h%us(m)
1883                      IF ( ALLOCATED( surf_usm_h%ts ) )                        &
1884                         surf_h(0)%ts(mm(0))      = surf_usm_h%ts(m)
1885                      IF ( ALLOCATED( surf_usm_h%qs ) )                        &
1886                         surf_h(0)%qs(mm(0))      = surf_usm_h%qs(m)
1887                      IF ( ALLOCATED( surf_usm_h%ss ) )                        &
1888                         surf_h(0)%ss(mm(0))      = surf_usm_h%ss(m)
1889                      IF ( ALLOCATED( surf_usm_h%qcs ) )                       &
1890                         surf_h(0)%qcs(mm(0))     = surf_usm_h%qcs(m)
1891                      IF ( ALLOCATED( surf_usm_h%ncs ) )                       &
1892                         surf_h(0)%ncs(mm(0))     = surf_usm_h%ncs(m)
1893                      IF ( ALLOCATED( surf_usm_h%qrs ) )                       &
1894                         surf_h(0)%qrs(mm(0))     = surf_usm_h%qrs(m)
1895                      IF ( ALLOCATED( surf_usm_h%nrs ) )                       &
1896                         surf_h(0)%nrs(mm(0))     = surf_usm_h%nrs(m)
1897                      IF ( ALLOCATED( surf_usm_h%ol ) )                        &
1898                         surf_h(0)%ol(mm(0))      = surf_usm_h%ol(m)
1899                      IF ( ALLOCATED( surf_usm_h%rib ) )                       &
1900                         surf_h(0)%rib(mm(0))     = surf_usm_h%rib(m)
1901                      IF ( ALLOCATED( surf_usm_h%usws ) )                      &
1902                         surf_h(0)%usws(mm(0))    = surf_usm_h%usws(m)
1903                      IF ( ALLOCATED( surf_usm_h%vsws ) )                      &
1904                         surf_h(0)%vsws(mm(0))    = surf_usm_h%vsws(m)
1905                      IF ( ALLOCATED( surf_usm_h%shf ) )                       &
1906                         surf_h(0)%shf(mm(0))     = surf_usm_h%shf(m)
1907                      IF ( ALLOCATED( surf_usm_h%qsws ) )                      &
1908                         surf_h(0)%qsws(mm(0))    = surf_usm_h%qsws(m)
1909                      IF ( ALLOCATED( surf_usm_h%ssws ) )                      &
1910                         surf_h(0)%ssws(mm(0))    = surf_usm_h%ssws(m)
1911                      IF ( ALLOCATED( surf_usm_h%ncsws ) )                     &
1912                         surf_h(0)%ncsws(mm(0))   = surf_usm_h%ncsws(m)
1913                      IF ( ALLOCATED( surf_usm_h%nrsws ) )                     &
1914                         surf_h(0)%nrsws(mm(0))   = surf_usm_h%nrsws(m)
1915                      IF ( ALLOCATED( surf_usm_h%sasws ) )                     &
1916                        surf_h(0)%sasws(mm(0))   = surf_usm_h%sasws(m)
1917               
1918                      mm(0) = mm(0) + 1
1919             
1920                   ENDDO
1921
1922
1923                ENDIF
1924
1925             ENDDO
1926
1927          ENDDO
1928          IF ( l == 0 )  THEN
1929             surf_h(l)%start_index = MAX( surf_def_h(l)%start_index,           &
1930                                          surf_lsm_h%start_index,              &
1931                                          surf_usm_h%start_index )
1932             surf_h(l)%end_index   = MAX( surf_def_h(l)%end_index,             &
1933                                          surf_lsm_h%end_index,                &
1934                                          surf_usm_h%end_index )
1935          ELSE
1936             surf_h(l)%start_index = surf_def_h(l)%start_index
1937             surf_h(l)%end_index   = surf_def_h(l)%end_index
1938          ENDIF
1939       ENDDO
1940
1941
1942       mm(0:3) = 1
1943       DO  l = 0, 3
1944          DO  i = nxl, nxr
1945             DO  j = nys, nyn
1946                DO  m = surf_def_v(l)%start_index(j,i),                        &
1947                        surf_def_v(l)%end_index(j,i)
1948                   IF ( ALLOCATED( surf_def_v(l)%us ) )                        &
1949                      surf_v(l)%us(mm(l))      = surf_def_v(l)%us(m)
1950                   IF ( ALLOCATED( surf_def_v(l)%ts ) )                        &
1951                      surf_v(l)%ts(mm(l))      = surf_def_v(l)%ts(m)
1952                   IF ( ALLOCATED( surf_def_v(l)%qs ) )                        &
1953                      surf_v(l)%qs(mm(l))      = surf_def_v(l)%qs(m)
1954                   IF ( ALLOCATED( surf_def_v(l)%ss ) )                        &
1955                      surf_v(l)%ss(mm(l))      = surf_def_v(l)%ss(m)
1956                   IF ( ALLOCATED( surf_def_v(l)%qcs ) )                       &
1957                      surf_v(l)%qcs(mm(l))     = surf_def_v(l)%qcs(m)
1958                   IF ( ALLOCATED( surf_def_v(l)%ncs ) )                       &
1959                      surf_v(l)%ncs(mm(l))     = surf_def_v(l)%ncs(m)
1960                   IF ( ALLOCATED( surf_def_v(l)%qrs ) )                       &
1961                      surf_v(l)%qrs(mm(l))     = surf_def_v(l)%qrs(m)
1962                   IF ( ALLOCATED( surf_def_v(l)%nrs ) )                       &
1963                      surf_v(l)%nrs(mm(l))     = surf_def_v(l)%nrs(m)
1964                   IF ( ALLOCATED( surf_def_v(l)%ol ) )                        &
1965                      surf_v(l)%ol(mm(l))      = surf_def_v(l)%ol(m)
1966                   IF ( ALLOCATED( surf_def_v(l)%rib ) )                       &
1967                      surf_v(l)%rib(mm(l))     = surf_def_v(l)%rib(m)
1968                   IF ( ALLOCATED( surf_def_v(l)%shf ) )                       &
1969                      surf_v(l)%shf(mm(l))     = surf_def_v(l)%shf(m)
1970                   IF ( ALLOCATED( surf_def_v(l)%qsws ) )                      &
1971                      surf_v(l)%qsws(mm(l))    = surf_def_v(l)%qsws(m)
1972                   IF ( ALLOCATED( surf_def_v(l)%ssws ) )                      &
1973                      surf_v(l)%ssws(mm(l))    = surf_def_v(l)%ssws(m)
1974                   IF ( ALLOCATED( surf_def_v(l)%ncsws ) )                     &
1975                      surf_v(l)%ncsws(mm(l))   = surf_def_v(l)%ncsws(m)
1976                   IF ( ALLOCATED( surf_def_v(l)%nrsws ) )                     &
1977                      surf_v(l)%nrsws(mm(l))   = surf_def_v(l)%nrsws(m)
1978                   IF ( ALLOCATED( surf_def_v(l)%sasws ) )                     &
1979                      surf_v(l)%sasws(mm(l))   = surf_def_v(l)%sasws(m)
1980                   IF ( ALLOCATED( surf_def_v(l)%mom_flux_uv) )                &
1981                      surf_v(l)%mom_flux_uv(mm(l))  = surf_def_v(l)%mom_flux_uv(m)
1982                   IF ( ALLOCATED( surf_def_v(l)%mom_flux_w) )                 &
1983                      surf_v(l)%mom_flux_w(mm(l))   = surf_def_v(l)%mom_flux_w(m)
1984                   IF ( ALLOCATED( surf_def_v(l)%mom_flux_tke) )               &
1985                      surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_def_v(l)%mom_flux_tke(0:1,m)
1986               
1987                   mm(l) = mm(l) + 1
1988                ENDDO
1989
1990                DO  m = surf_lsm_v(l)%start_index(j,i),                        &
1991                        surf_lsm_v(l)%end_index(j,i)
1992                   IF ( ALLOCATED( surf_lsm_v(l)%us ) )                        &
1993                      surf_v(l)%us(mm(l))      = surf_lsm_v(l)%us(m)
1994                   IF ( ALLOCATED( surf_lsm_v(l)%ts ) )                        &
1995                      surf_v(l)%ts(mm(l))      = surf_lsm_v(l)%ts(m)
1996                   IF ( ALLOCATED( surf_lsm_v(l)%qs ) )                        &
1997                      surf_v(l)%qs(mm(l))      = surf_lsm_v(l)%qs(m)
1998                   IF ( ALLOCATED( surf_lsm_v(l)%ss ) )                        &
1999                      surf_v(l)%ss(mm(l))      = surf_lsm_v(l)%ss(m)
2000                   IF ( ALLOCATED( surf_lsm_v(l)%qcs ) )                       &
2001                      surf_v(l)%qcs(mm(l))     = surf_lsm_v(l)%qcs(m)
2002                   IF ( ALLOCATED( surf_lsm_v(l)%ncs ) )                       &
2003                      surf_v(l)%ncs(mm(l))     = surf_lsm_v(l)%ncs(m)
2004                   IF ( ALLOCATED( surf_lsm_v(l)%qrs ) )                       &
2005                      surf_v(l)%qrs(mm(l))     = surf_lsm_v(l)%qrs(m)
2006                   IF ( ALLOCATED( surf_lsm_v(l)%nrs ) )                       &
2007                      surf_v(l)%nrs(mm(l))     = surf_lsm_v(l)%nrs(m)
2008                   IF ( ALLOCATED( surf_lsm_v(l)%ol ) )                        &
2009                      surf_v(l)%ol(mm(l))      = surf_lsm_v(l)%ol(m)
2010                   IF ( ALLOCATED( surf_lsm_v(l)%rib ) )                       &
2011                      surf_v(l)%rib(mm(l))     = surf_lsm_v(l)%rib(m)
2012                   IF ( ALLOCATED( surf_lsm_v(l)%usws ) )                      &
2013                      surf_v(l)%usws(mm(l))    = surf_lsm_v(l)%usws(m)
2014                   IF ( ALLOCATED( surf_lsm_v(l)%vsws ) )                      &
2015                      surf_v(l)%vsws(mm(l))    = surf_lsm_v(l)%vsws(m)
2016                   IF ( ALLOCATED( surf_lsm_v(l)%shf ) )                       &
2017                      surf_v(l)%shf(mm(l))     = surf_lsm_v(l)%shf(m)
2018                   IF ( ALLOCATED( surf_lsm_v(l)%qsws ) )                      &
2019                      surf_v(l)%qsws(mm(l))    = surf_lsm_v(l)%qsws(m)
2020                   IF ( ALLOCATED( surf_lsm_v(l)%ssws ) )                      &
2021                      surf_v(l)%ssws(mm(l))    = surf_lsm_v(l)%ssws(m)
2022                   IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) )                     &
2023                      surf_v(l)%ncsws(mm(l))   = surf_lsm_v(l)%ncsws(m)
2024                   IF ( ALLOCATED( surf_lsm_v(l)%nrsws ) )                     &
2025                      surf_v(l)%nrsws(mm(l))   = surf_lsm_v(l)%nrsws(m)
2026                   IF ( ALLOCATED( surf_lsm_v(l)%sasws ) )                     &
2027                      surf_v(l)%sasws(mm(l))   = surf_lsm_v(l)%sasws(m)
2028                   IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_uv) )                &
2029                      surf_v(l)%mom_flux_uv(mm(l))  = surf_lsm_v(l)%mom_flux_uv(m)
2030                   IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_w) )                 &
2031                      surf_v(l)%mom_flux_w(mm(l))   = surf_lsm_v(l)%mom_flux_w(m)
2032                   IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_tke) )               &
2033                      surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_lsm_v(l)%mom_flux_tke(0:1,m)
2034               
2035                   mm(l) = mm(l) + 1
2036                ENDDO
2037
2038                DO  m = surf_usm_v(l)%start_index(j,i),                        &
2039                        surf_usm_v(l)%end_index(j,i)
2040                   IF ( ALLOCATED( surf_usm_v(l)%us ) )                        &
2041                      surf_v(l)%us(mm(l))      = surf_usm_v(l)%us(m)
2042                   IF ( ALLOCATED( surf_usm_v(l)%ts ) )                        &
2043                      surf_v(l)%ts(mm(l))      = surf_usm_v(l)%ts(m)
2044                   IF ( ALLOCATED( surf_usm_v(l)%qs ) )                        &
2045                      surf_v(l)%qs(mm(l))      = surf_usm_v(l)%qs(m)
2046                   IF ( ALLOCATED( surf_usm_v(l)%ss ) )                        &
2047                      surf_v(l)%ss(mm(l))      = surf_usm_v(l)%ss(m)
2048                   IF ( ALLOCATED( surf_usm_v(l)%qcs ) )                       &
2049                      surf_v(l)%qcs(mm(l))     = surf_usm_v(l)%qcs(m)
2050                   IF ( ALLOCATED( surf_usm_v(l)%ncs ) )                       &
2051                      surf_v(l)%ncs(mm(l))     = surf_usm_v(l)%ncs(m)
2052                   IF ( ALLOCATED( surf_usm_v(l)%qrs ) )                       &
2053                      surf_v(l)%qrs(mm(l))     = surf_usm_v(l)%qrs(m)
2054                   IF ( ALLOCATED( surf_usm_v(l)%nrs ) )                       &
2055                      surf_v(l)%nrs(mm(l))     = surf_usm_v(l)%nrs(m)
2056                   IF ( ALLOCATED( surf_usm_v(l)%ol ) )                        &
2057                      surf_v(l)%ol(mm(l))      = surf_usm_v(l)%ol(m)
2058                   IF ( ALLOCATED( surf_usm_v(l)%rib ) )                       &
2059                      surf_v(l)%rib(mm(l))     = surf_usm_v(l)%rib(m)
2060                   IF ( ALLOCATED( surf_usm_v(l)%usws ) )                      &
2061                      surf_v(l)%usws(mm(l))    = surf_usm_v(l)%usws(m)
2062                   IF ( ALLOCATED( surf_usm_v(l)%vsws ) )                      &
2063                      surf_v(l)%vsws(mm(l))    = surf_usm_v(l)%vsws(m)
2064                   IF ( ALLOCATED( surf_usm_v(l)%shf ) )                       &
2065                      surf_v(l)%shf(mm(l))     = surf_usm_v(l)%shf(m)
2066                   IF ( ALLOCATED( surf_usm_v(l)%qsws ) )                      &
2067                      surf_v(l)%qsws(mm(l))    = surf_usm_v(l)%qsws(m)
2068                   IF ( ALLOCATED( surf_usm_v(l)%ssws ) )                      &
2069                      surf_v(l)%ssws(mm(l))    = surf_usm_v(l)%ssws(m)
2070                   IF ( ALLOCATED( surf_usm_v(l)%ncsws ) )                     &
2071                      surf_v(l)%ncsws(mm(l))   = surf_usm_v(l)%ncsws(m)
2072                   IF ( ALLOCATED( surf_usm_v(l)%nrsws ) )                     &
2073                      surf_v(l)%nrsws(mm(l))   = surf_usm_v(l)%nrsws(m)
2074                   IF ( ALLOCATED( surf_usm_v(l)%sasws ) )                     &
2075                      surf_v(l)%sasws(mm(l))   = surf_usm_v(l)%sasws(m)
2076                   IF ( ALLOCATED( surf_usm_v(l)%mom_flux_uv) )                &
2077                      surf_v(l)%mom_flux_uv(mm(l))  = surf_usm_v(l)%mom_flux_uv(m)
2078                   IF ( ALLOCATED( surf_usm_v(l)%mom_flux_w) )                 &
2079                      surf_v(l)%mom_flux_w(mm(l))   = surf_usm_v(l)%mom_flux_w(m)
2080                   IF ( ALLOCATED( surf_usm_v(l)%mom_flux_tke) )               &
2081                      surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_usm_v(l)%mom_flux_tke(0:1,m)
2082               
2083                   mm(l) = mm(l) + 1
2084                ENDDO
2085             
2086             ENDDO
2087          ENDDO
2088!
2089!--       Finally, determine start- and end-index for the respective surface
2090          surf_v(l)%start_index = MAX( surf_def_v(l)%start_index,              &
2091                                       surf_lsm_v(l)%start_index,              &
2092                                       surf_usm_v(l)%start_index )
2093          surf_v(l)%end_index   = MAX( surf_def_v(l)%end_index,                &
2094                                       surf_lsm_v(l)%end_index,                &
2095                                       surf_usm_v(l)%end_index   )
2096       ENDDO
2097
2098       WRITE ( 14 )  'ns_h_on_file                  '
2099       WRITE ( 14 )   ns_h_on_file
2100       WRITE ( 14 )  'ns_v_on_file                  '
2101       WRITE ( 14 )   ns_v_on_file
2102!
2103!--    Write required restart data.
2104!--    Start with horizontal surfaces (upward-, downward-facing, and model top)
2105       DO  l = 0, 2
2106          WRITE( dum, '(I1)')  l
2107         
2108          WRITE ( 14 )  'surf_h(' // dum // ')%start_index         ' 
2109          WRITE ( 14 )   surf_h(l)%start_index
2110          WRITE ( 14 )  'surf_h(' // dum // ')%end_index           ' 
2111          WRITE ( 14 )   surf_h(l)%end_index
2112
2113          WRITE ( 14 )  'surf_h(' // dum // ')%us                  ' 
2114          IF ( ALLOCATED ( surf_h(l)%us ) )  THEN
2115             WRITE ( 14 )  surf_h(l)%us
2116          ENDIF
2117          WRITE ( 14 )  'surf_h(' // dum // ')%ts                  ' 
2118          IF ( ALLOCATED ( surf_h(l)%ts ) )  THEN
2119             WRITE ( 14 )  surf_h(l)%ts
2120          ENDIF
2121          WRITE ( 14 )  'surf_h(' // dum // ')%qs                  ' 
2122          IF ( ALLOCATED ( surf_h(l)%qs ) )  THEN
2123             WRITE ( 14 )  surf_h(l)%qs
2124          ENDIF
2125          WRITE ( 14 )  'surf_h(' // dum // ')%ss                  ' 
2126          IF ( ALLOCATED ( surf_h(l)%ss ) )  THEN
2127             WRITE ( 14 )  surf_h(l)%ss
2128          ENDIF
2129          WRITE ( 14 )  'surf_h(' // dum // ')%qcs                 '
2130          IF ( ALLOCATED ( surf_h(l)%qcs ) )  THEN 
2131             WRITE ( 14 )  surf_h(l)%qcs
2132          ENDIF
2133          WRITE ( 14 )  'surf_h(' // dum // ')%ncs                 ' 
2134          IF ( ALLOCATED ( surf_h(l)%ncs ) )  THEN
2135             WRITE ( 14 )  surf_h(l)%ncs
2136          ENDIF
2137          WRITE ( 14 )  'surf_h(' // dum // ')%qrs                 '
2138          IF ( ALLOCATED ( surf_h(l)%qrs ) )  THEN 
2139             WRITE ( 14 )  surf_h(l)%qrs
2140          ENDIF
2141          WRITE ( 14 )  'surf_h(' // dum // ')%nrs                 ' 
2142          IF ( ALLOCATED ( surf_h(l)%nrs ) )  THEN
2143             WRITE ( 14 )  surf_h(l)%nrs
2144          ENDIF
2145          WRITE ( 14 )  'surf_h(' // dum // ')%ol                  ' 
2146          IF ( ALLOCATED ( surf_h(l)%ol ) )  THEN
2147             WRITE ( 14 )  surf_h(l)%ol
2148          ENDIF
2149          WRITE ( 14 )  'surf_h(' // dum // ')%rib                 ' 
2150          IF ( ALLOCATED ( surf_h(l)%rib ) )  THEN
2151             WRITE ( 14 )  surf_h(l)%rib
2152          ENDIF
2153          WRITE ( 14 )  'surf_h(' // dum // ')%usws                ' 
2154          IF ( ALLOCATED ( surf_h(l)%usws ) )  THEN
2155             WRITE ( 14 )  surf_h(l)%usws
2156          ENDIF
2157          WRITE ( 14 )  'surf_h(' // dum // ')%vsws                ' 
2158          IF ( ALLOCATED ( surf_h(l)%vsws ) )  THEN
2159             WRITE ( 14 )  surf_h(l)%vsws
2160          ENDIF
2161          WRITE ( 14 )  'surf_h(' // dum // ')%shf                 ' 
2162          IF ( ALLOCATED ( surf_h(l)%shf ) )  THEN
2163             WRITE ( 14 )  surf_h(l)%shf
2164          ENDIF
2165          WRITE ( 14 )  'surf_h(' // dum // ')%qsws                ' 
2166          IF ( ALLOCATED ( surf_h(l)%qsws ) )  THEN
2167             WRITE ( 14 )  surf_h(l)%qsws
2168          ENDIF
2169          WRITE ( 14 )  'surf_h(' // dum // ')%ssws                ' 
2170          IF ( ALLOCATED ( surf_h(l)%ssws ) )  THEN
2171             WRITE ( 14 )  surf_h(l)%ssws
2172          ENDIF
2173          WRITE ( 14 )  'surf_h(' // dum // ')%qcsws               ' 
2174          IF ( ALLOCATED ( surf_h(l)%qcsws ) )  THEN
2175             WRITE ( 14 )  surf_h(l)%qcsws
2176          ENDIF
2177          WRITE ( 14 )  'surf_h(' // dum // ')%ncsws               ' 
2178          IF ( ALLOCATED ( surf_h(l)%ncsws ) )  THEN
2179             WRITE ( 14 )  surf_h(l)%ncsws
2180          ENDIF
2181          WRITE ( 14 )  'surf_h(' // dum // ')%qrsws               ' 
2182          IF ( ALLOCATED ( surf_h(l)%qrsws ) )  THEN
2183             WRITE ( 14 )  surf_h(l)%qrsws
2184          ENDIF
2185          WRITE ( 14 )  'surf_h(' // dum // ')%nrsws               ' 
2186          IF ( ALLOCATED ( surf_h(l)%nrsws ) )  THEN
2187             WRITE ( 14 )  surf_h(l)%nrsws
2188          ENDIF
2189          WRITE ( 14 )  'surf_h(' // dum // ')%sasws               ' 
2190          IF ( ALLOCATED ( surf_h(l)%sasws ) )  THEN
2191             WRITE ( 14 )  surf_h(l)%sasws
2192          ENDIF
2193       ENDDO
2194!
2195!--    Write vertical surfaces
2196       DO  l = 0, 3
2197          WRITE( dum, '(I1)')  l
2198
2199          WRITE ( 14 )  'surf_v(' // dum // ')%start_index         ' 
2200          WRITE ( 14 )   surf_v(l)%start_index
2201          WRITE ( 14 )  'surf_v(' // dum // ')%end_index           ' 
2202          WRITE ( 14 )   surf_v(l)%end_index
2203
2204          WRITE ( 14 )  'surf_v(' // dum // ')%us                  ' 
2205          IF ( ALLOCATED ( surf_v(l)%us ) )  THEN
2206             WRITE ( 14 )  surf_v(l)%us
2207          ENDIF
2208          WRITE ( 14 )  'surf_v(' // dum // ')%ts                  ' 
2209          IF ( ALLOCATED ( surf_v(l)%ts ) )  THEN
2210             WRITE ( 14 )  surf_v(l)%ts
2211          ENDIF
2212          WRITE ( 14 )  'surf_v(' // dum // ')%qs                  ' 
2213          IF ( ALLOCATED ( surf_v(l)%qs ) )  THEN
2214             WRITE ( 14 )  surf_v(l)%qs
2215          ENDIF
2216          WRITE ( 14 )  'surf_v(' // dum // ')%ss                  ' 
2217          IF ( ALLOCATED ( surf_v(l)%ss ) )  THEN
2218             WRITE ( 14 )  surf_v(l)%ss
2219          ENDIF
2220          WRITE ( 14 )  'surf_v(' // dum // ')%qcs                 ' 
2221          IF ( ALLOCATED ( surf_v(l)%qcs ) )  THEN
2222             WRITE ( 14 )  surf_v(l)%qcs
2223          ENDIF
2224          WRITE ( 14 )  'surf_v(' // dum // ')%ncs                 ' 
2225          IF ( ALLOCATED ( surf_v(l)%ncs ) )  THEN
2226             WRITE ( 14 )  surf_v(l)%ncs
2227          ENDIF
2228          WRITE ( 14 )  'surf_v(' // dum // ')%qrs                 ' 
2229          IF ( ALLOCATED ( surf_v(l)%qrs ) )  THEN
2230             WRITE ( 14 )  surf_v(l)%qrs
2231          ENDIF
2232          WRITE ( 14 )  'surf_v(' // dum // ')%nrs                 ' 
2233          IF ( ALLOCATED ( surf_v(l)%nrs ) )  THEN
2234             WRITE ( 14 )  surf_v(l)%nrs
2235          ENDIF
2236          WRITE ( 14 )  'surf_v(' // dum // ')%ol                  ' 
2237          IF ( ALLOCATED ( surf_v(l)%ol ) )  THEN
2238             WRITE ( 14 )  surf_v(l)%ol
2239          ENDIF
2240          WRITE ( 14 )  'surf_v(' // dum // ')%rib                 ' 
2241          IF ( ALLOCATED ( surf_v(l)%rib ) )  THEN
2242             WRITE ( 14 )  surf_v(l)%rib
2243          ENDIF
2244          WRITE ( 14 )  'surf_v(' // dum // ')%shf                 ' 
2245          IF ( ALLOCATED ( surf_v(l)%shf ) )  THEN
2246             WRITE ( 14 )  surf_v(l)%shf
2247          ENDIF
2248          WRITE ( 14 )  'surf_v(' // dum // ')%qsws                ' 
2249          IF ( ALLOCATED ( surf_v(l)%qsws ) )  THEN
2250             WRITE ( 14 )  surf_v(l)%qsws
2251          ENDIF
2252          WRITE ( 14 )  'surf_v(' // dum // ')%ssws                ' 
2253          IF ( ALLOCATED ( surf_v(l)%ssws ) )  THEN
2254             WRITE ( 14 )  surf_v(l)%ssws
2255          ENDIF
2256          WRITE ( 14 )  'surf_v(' // dum // ')%qcsws               ' 
2257          IF ( ALLOCATED ( surf_v(l)%qcsws ) )  THEN
2258             WRITE ( 14 )  surf_v(l)%qcsws
2259          ENDIF
2260          WRITE ( 14 )  'surf_v(' // dum // ')%ncsws               ' 
2261          IF ( ALLOCATED ( surf_v(l)%ncsws ) )  THEN
2262             WRITE ( 14 )  surf_v(l)%ncsws
2263          ENDIF
2264          WRITE ( 14 )  'surf_v(' // dum // ')%qrsws               ' 
2265          IF ( ALLOCATED ( surf_v(l)%qrsws ) )  THEN
2266             WRITE ( 14 )  surf_v(l)%qrsws
2267          ENDIF
2268          WRITE ( 14 )  'surf_v(' // dum // ')%nrsws               ' 
2269          IF ( ALLOCATED ( surf_v(l)%nrsws ) )  THEN
2270             WRITE ( 14 )  surf_v(l)%nrsws
2271          ENDIF
2272          WRITE ( 14 )  'surf_v(' // dum // ')%sasws               ' 
2273          IF ( ALLOCATED ( surf_v(l)%sasws ) )  THEN
2274             WRITE ( 14 )  surf_v(l)%sasws
2275          ENDIF
2276          WRITE ( 14 )  'surf_v(' // dum // ')%mom_uv              ' 
2277          IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) )  THEN
2278             WRITE ( 14 )  surf_v(l)%mom_flux_uv
2279          ENDIF
2280          WRITE ( 14 )  'surf_v(' // dum // ')%mom_w               ' 
2281          IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) )  THEN
2282             WRITE ( 14 )  surf_v(l)%mom_flux_w
2283          ENDIF
2284          WRITE ( 14 )  'surf_v(' // dum // ')%mom_tke             ' 
2285          IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) )  THEN
2286             WRITE ( 14 )  surf_v(l)%mom_flux_tke
2287          ENDIF
2288
2289       ENDDO
2290
2291       WRITE ( 14 )  '*** end surf ***              '
2292
2293    END SUBROUTINE surface_write_restart_data
2294
2295
2296!------------------------------------------------------------------------------!
2297! Description:
2298! ------------
2299!> Reads surface-related restart data. Please note, restart data for a certain
2300!> surface orientation (e.g. horizontal upward-facing) is stored in one
2301!> array, even if surface elements may belong to different surface types
2302!> natural or urban for example). Surface elements are redistributed into its
2303!> respective surface types within this routine. This allows e.g. changing the
2304!> surface type after reading the restart data, which might be required in case
2305!> of cyclic_fill mode.
2306!------------------------------------------------------------------------------!
2307    SUBROUTINE surface_read_restart_data( ii,                                  &
2308                                       nxlfa, nxl_on_file, nxrfa, nxr_on_file, &
2309                                       nynfa, nyn_on_file, nysfa, nys_on_file, &
2310                                       offset_xa, offset_ya, overlap_count )
2311
2312       USE pegrid,                                                             &
2313           ONLY: numprocs_previous_run
2314
2315       CHARACTER (LEN=1)  ::  dum         !< dummy to create correct string for reading input variable
2316       CHARACTER (LEN=30) ::  field_chr   !< input variable
2317
2318       INTEGER(iwp)       ::  i           !< running index along x-direction, refers to former domain size
2319       INTEGER(iwp)       ::  ic          !< running index along x-direction, refers to current domain size
2320       INTEGER(iwp)       ::  j           !< running index along y-direction, refers to former domain size
2321       INTEGER(iwp)       ::  jc          !< running index along y-direction, refers to former domain size
2322       INTEGER(iwp)       ::  k           !< running index along z-direction
2323       INTEGER(iwp)       ::  l           !< index variable for surface type
2324       INTEGER(iwp)       ::  m           !< running index for surface elements, refers to gathered array encompassing all surface types
2325       INTEGER(iwp)       ::  mm          !< running index for surface elements, refers to individual surface types
2326
2327       INTEGER(iwp)       ::  ii               !< running index over input files
2328       INTEGER(iwp)       ::  kk               !< running index over previous input files covering current local domain
2329       INTEGER(iwp)       ::  nxlc             !< index of left boundary on current subdomain
2330       INTEGER(iwp)       ::  nxlf             !< index of left boundary on former subdomain
2331       INTEGER(iwp)       ::  nxl_on_file      !< index of left boundary on former local domain
2332       INTEGER(iwp)       ::  nxrc             !< index of right boundary on current subdomain
2333       INTEGER(iwp)       ::  nxrf             !< index of right boundary on former subdomain
2334       INTEGER(iwp)       ::  nxr_on_file      !< index of right boundary on former local domain 
2335       INTEGER(iwp)       ::  nync             !< index of north boundary on current subdomain
2336       INTEGER(iwp)       ::  nynf             !< index of north boundary on former subdomain
2337       INTEGER(iwp)       ::  nyn_on_file      !< index of norht boundary on former local domain 
2338       INTEGER(iwp)       ::  nysc             !< index of south boundary on current subdomain
2339       INTEGER(iwp)       ::  nysf             !< index of south boundary on former subdomain
2340       INTEGER(iwp)       ::  nys_on_file      !< index of south boundary on former local domain 
2341       INTEGER(iwp)       ::  overlap_count    !< number of overlaps
2342 
2343       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !<
2344       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa       !<
2345       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa       !<
2346       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa       !<
2347       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa   !<
2348       INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !<
2349
2350
2351       LOGICAL                         ::  horizontal_surface !< flag indicating horizontal surfaces
2352       LOGICAL                         ::  surf_match_def     !< flag indicating that surface element is of default type
2353       LOGICAL                         ::  surf_match_lsm     !< flag indicating that surface element is of natural type
2354       LOGICAL                         ::  surf_match_usm     !< flag indicating that surface element is of urban type
2355       LOGICAL                         ::  vertical_surface   !< flag indicating vertical surfaces
2356
2357       TYPE(surf_type), DIMENSION(0:2) ::  surf_h             !< horizontal surface type on file
2358       TYPE(surf_type), DIMENSION(0:3) ::  surf_v             !< vertical surface type on file
2359
2360!
2361!--    Read number of respective surface elements on file
2362       READ ( 13 )  field_chr
2363       IF ( TRIM( field_chr ) /= 'ns_h_on_file' )  THEN
2364!
2365!--       Add a proper error message
2366       ENDIF
2367       READ ( 13 ) ns_h_on_file
2368
2369       READ ( 13 )  field_chr
2370       IF ( TRIM( field_chr ) /= 'ns_v_on_file' )  THEN
2371!
2372!--       Add a proper error message
2373       ENDIF
2374       READ ( 13 ) ns_v_on_file
2375!
2376!--    Allocate memory for number of surface elements on file. Please note,
2377!--    these number is not necessarily the same as the final number of surface
2378!--    elements on local domain, which is the case if processor topology changes
2379!--    during restart runs.
2380!--    Horizontal upward facing
2381       surf_h(0)%ns = ns_h_on_file(0)
2382       CALL allocate_surface_attributes_h( surf_h(0),                          &
2383                                           nys_on_file, nyn_on_file,           &
2384                                           nxl_on_file, nxr_on_file )
2385!
2386!--    Horizontal downward facing
2387       surf_h(1)%ns = ns_h_on_file(1)
2388       CALL allocate_surface_attributes_h( surf_h(1),                          &
2389                                           nys_on_file, nyn_on_file,           &
2390                                           nxl_on_file, nxr_on_file )
2391!
2392!--    Model top
2393       surf_h(2)%ns = ns_h_on_file(2)
2394       CALL allocate_surface_attributes_h_top( surf_h(2),                      &
2395                                               nys_on_file, nyn_on_file,       &
2396                                               nxl_on_file, nxr_on_file )
2397!
2398!--    Vertical surfaces
2399       DO  l = 0, 3
2400          surf_v(l)%ns = ns_v_on_file(l)
2401          CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,              &
2402                                              nys_on_file, nyn_on_file,        &
2403                                              nxl_on_file, nxr_on_file )
2404       ENDDO
2405
2406       IF ( initializing_actions == 'read_restart_data'  .OR.                  &
2407            initializing_actions == 'cyclic_fill' )  THEN
2408!
2409!--       Initial setting of flags for horizontal and vertical surfaces, will
2410!--       be set after start- and end-indices are read.
2411          horizontal_surface = .FALSE.
2412          vertical_surface   = .FALSE.
2413
2414          READ ( 13 )  field_chr
2415
2416          DO  WHILE ( TRIM( field_chr ) /= '*** end surf ***' )
2417!
2418!--          Map data on file as often as needed (data are read only for k=1)
2419             DO  kk = 1, overlap_count
2420!
2421!--             Get the index range of the subdomain on file which overlap with the
2422!--             current subdomain
2423                nxlf = nxlfa(ii,kk)
2424                nxlc = nxlfa(ii,kk) + offset_xa(ii,kk)
2425                nxrf = nxrfa(ii,kk)
2426                nxrc = nxrfa(ii,kk) + offset_xa(ii,kk)
2427                nysf = nysfa(ii,kk)
2428                nysc = nysfa(ii,kk) + offset_ya(ii,kk)
2429                nynf = nynfa(ii,kk)
2430                nync = nynfa(ii,kk) + offset_ya(ii,kk)
2431
2432                SELECT CASE ( TRIM( field_chr ) )
2433
2434                   CASE ( 'surf_h(0)%start_index' )
2435                      IF ( kk == 1 )                                           &
2436                         READ ( 13 )  surf_h(0)%start_index
2437                      l = 0
2438                   CASE ( 'surf_h(0)%end_index' )   
2439                      IF ( kk == 1 )                                           &
2440                         READ ( 13 )  surf_h(0)%end_index
2441                      horizontal_surface = .TRUE.
2442                      vertical_surface   = .FALSE.
2443                   CASE ( 'surf_h(0)%us' )         
2444                      IF ( ALLOCATED( surf_h(0)%us )  .AND.  kk == 1 )         &
2445                         READ ( 13 )  surf_h(0)%us
2446                   CASE ( 'surf_h(0)%ts' )         
2447                      IF ( ALLOCATED( surf_h(0)%ts )  .AND.  kk == 1 )         &
2448                         READ ( 13 )  surf_h(0)%ts
2449                   CASE ( 'surf_h(0)%qs' )         
2450                      IF ( ALLOCATED( surf_h(0)%qs )  .AND.  kk == 1 )         &
2451                         READ ( 13 )  surf_h(0)%qs
2452                   CASE ( 'surf_h(0)%ss' )         
2453                      IF ( ALLOCATED( surf_h(0)%ss )  .AND.  kk == 1 )         &
2454                         READ ( 13 )  surf_h(0)%ss
2455                   CASE ( 'surf_h(0)%qcs' )         
2456                      IF ( ALLOCATED( surf_h(0)%qcs )  .AND.  kk == 1 )        &
2457                         READ ( 13 )  surf_h(0)%qcs
2458                   CASE ( 'surf_h(0)%ncs' )         
2459                      IF ( ALLOCATED( surf_h(0)%ncs )  .AND.  kk == 1 )        &
2460                         READ ( 13 )  surf_h(0)%ncs
2461                   CASE ( 'surf_h(0)%qrs' )         
2462                      IF ( ALLOCATED( surf_h(0)%qrs )  .AND.  kk == 1 )        &
2463                         READ ( 13 )  surf_h(0)%qrs
2464                   CASE ( 'surf_h(0)%nrs' )         
2465                      IF ( ALLOCATED( surf_h(0)%nrs )  .AND.  kk == 1 )        &
2466                         READ ( 13 )  surf_h(0)%nrs
2467                   CASE ( 'surf_h(0)%ol' )         
2468                      IF ( ALLOCATED( surf_h(0)%ol )  .AND.  kk == 1 )         &
2469                         READ ( 13 )  surf_h(0)%ol
2470                   CASE ( 'surf_h(0)%rib' )         
2471                      IF ( ALLOCATED( surf_h(0)%rib )  .AND.  kk == 1 )        &
2472                         READ ( 13 )  surf_h(0)%rib
2473                   CASE ( 'surf_h(0)%usws' )         
2474                      IF ( ALLOCATED( surf_h(0)%usws )  .AND.  kk == 1 )       &
2475                         READ ( 13 )  surf_h(0)%usws
2476                   CASE ( 'surf_h(0)%vsws' )         
2477                      IF ( ALLOCATED( surf_h(0)%vsws )  .AND.  kk == 1 )       &
2478                         READ ( 13 )  surf_h(0)%vsws
2479                   CASE ( 'surf_h(0)%shf' )         
2480                      IF ( ALLOCATED( surf_h(0)%shf )  .AND.  kk == 1 )        &
2481                         READ ( 13 )  surf_h(0)%shf
2482                   CASE ( 'surf_h(0)%qsws' )         
2483                      IF ( ALLOCATED( surf_h(0)%qsws )  .AND.  kk == 1 )       &
2484                         READ ( 13 )  surf_h(0)%qsws
2485                   CASE ( 'surf_h(0)%ssws' )         
2486                      IF ( ALLOCATED( surf_h(0)%ssws )  .AND.  kk == 1 )       &
2487                         READ ( 13 )  surf_h(0)%ssws
2488                   CASE ( 'surf_h(0)%qcsws' )         
2489                      IF ( ALLOCATED( surf_h(0)%qcsws )  .AND.  kk == 1 )      &
2490                         READ ( 13 )  surf_h(0)%qcsws
2491                   CASE ( 'surf_h(0)%ncsws' )         
2492                      IF ( ALLOCATED( surf_h(0)%ncsws )  .AND.  kk == 1 )      &
2493                         READ ( 13 )  surf_h(0)%ncsws
2494                   CASE ( 'surf_h(0)%qrsws' )         
2495                      IF ( ALLOCATED( surf_h(0)%qrsws )  .AND.  kk == 1 )      &
2496                         READ ( 13 )  surf_h(0)%qrsws
2497                   CASE ( 'surf_h(0)%nrsws' )         
2498                      IF ( ALLOCATED( surf_h(0)%nrsws )  .AND.  kk == 1 )      &
2499                         READ ( 13 )  surf_h(0)%nrsws
2500                   CASE ( 'surf_h(0)%sasws' )         
2501                      IF ( ALLOCATED( surf_h(0)%sasws )  .AND.  kk == 1 )      &
2502                         READ ( 13 )  surf_h(0)%sasws
2503
2504                   CASE ( 'surf_h(1)%start_index' )   
2505                      IF ( kk == 1 )                                           &
2506                         READ ( 13 )  surf_h(1)%start_index
2507                      l = 1
2508                   CASE ( 'surf_h(1)%end_index' )   
2509                      IF ( kk == 1 )                                           &
2510                         READ ( 13 )  surf_h(1)%end_index
2511                   CASE ( 'surf_h(1)%us' )         
2512                      IF ( ALLOCATED( surf_h(1)%us )  .AND.  kk == 1 )         &
2513                         READ ( 13 )  surf_h(1)%us
2514                   CASE ( 'surf_h(1)%ts' )         
2515                      IF ( ALLOCATED( surf_h(1)%ts )  .AND.  kk == 1 )         &
2516                         READ ( 13 )  surf_h(1)%ts
2517                   CASE ( 'surf_h(1)%qs' )         
2518                      IF ( ALLOCATED( surf_h(1)%qs )  .AND.  kk == 1 )         &
2519                         READ ( 13 )  surf_h(1)%qs
2520                   CASE ( 'surf_h(1)%ss' )         
2521                      IF ( ALLOCATED( surf_h(1)%ss )  .AND.  kk == 1 )         &
2522                         READ ( 13 )  surf_h(1)%ss
2523                   CASE ( 'surf_h(1)%qcs' )         
2524                      IF ( ALLOCATED( surf_h(1)%qcs )  .AND.  kk == 1 )        &
2525                         READ ( 13 )  surf_h(1)%qcs
2526                   CASE ( 'surf_h(1)%ncs' )         
2527                      IF ( ALLOCATED( surf_h(1)%ncs )  .AND.  kk == 1 )        &
2528                         READ ( 13 )  surf_h(1)%ncs
2529                   CASE ( 'surf_h(1)%qrs' )         
2530                      IF ( ALLOCATED( surf_h(1)%qrs )  .AND.  kk == 1 )        &
2531                         READ ( 13 )  surf_h(1)%qrs
2532                   CASE ( 'surf_h(1)%nrs' )         
2533                      IF ( ALLOCATED( surf_h(1)%nrs )  .AND.  kk == 1 )        &
2534                         READ ( 13 )  surf_h(1)%nrs
2535                   CASE ( 'surf_h(1)%ol' )         
2536                      IF ( ALLOCATED( surf_h(1)%ol )  .AND.  kk == 1 )         &
2537                         READ ( 13 )  surf_h(1)%ol
2538                   CASE ( 'surf_h(1)%rib' )         
2539                      IF ( ALLOCATED( surf_h(1)%rib )  .AND.  kk == 1 )        &
2540                         READ ( 13 )  surf_h(1)%rib
2541                   CASE ( 'surf_h(1)%usws' )         
2542                      IF ( ALLOCATED( surf_h(1)%usws )  .AND.  kk == 1 )       &
2543                         READ ( 13 )  surf_h(1)%usws
2544                   CASE ( 'surf_h(1)%vsws' )         
2545                      IF ( ALLOCATED( surf_h(1)%vsws )  .AND.  kk == 1 )       &
2546                         READ ( 13 )  surf_h(1)%vsws
2547                   CASE ( 'surf_h(1)%shf' )         
2548                      IF ( ALLOCATED( surf_h(1)%shf )  .AND.  kk == 1 )        &
2549                         READ ( 13 )  surf_h(1)%shf
2550                   CASE ( 'surf_h(1)%qsws' )         
2551                      IF ( ALLOCATED( surf_h(1)%qsws )  .AND.  kk == 1 )       &
2552                         READ ( 13 )  surf_h(1)%qsws
2553                   CASE ( 'surf_h(1)%ssws' )         
2554                      IF ( ALLOCATED( surf_h(1)%ssws )  .AND.  kk == 1 )       &
2555                         READ ( 13 )  surf_h(1)%ssws
2556                   CASE ( 'surf_h(1)%qcsws' )         
2557                      IF ( ALLOCATED( surf_h(1)%qcsws )  .AND.  kk == 1 )      &
2558                         READ ( 13 )  surf_h(1)%qcsws
2559                   CASE ( 'surf_h(1)%ncsws' )         
2560                      IF ( ALLOCATED( surf_h(1)%ncsws )  .AND.  kk == 1 )      &
2561                         READ ( 13 )  surf_h(1)%ncsws
2562                   CASE ( 'surf_h(1)%qrsws' )         
2563                      IF ( ALLOCATED( surf_h(1)%qrsws )  .AND.  kk == 1 )      &
2564                         READ ( 13 )  surf_h(1)%qrsws
2565                   CASE ( 'surf_h(1)%nrsws' )         
2566                      IF ( ALLOCATED( surf_h(1)%nrsws )  .AND.  kk == 1 )      &
2567                         READ ( 13 )  surf_h(1)%nrsws
2568                   CASE ( 'surf_h(1)%sasws' )         
2569                      IF ( ALLOCATED( surf_h(1)%sasws )  .AND.  kk == 1 )      &
2570                         READ ( 13 )  surf_h(1)%sasws
2571
2572                   CASE ( 'surf_h(2)%start_index' )   
2573                      IF ( kk == 1 )                                           &
2574                         READ ( 13 )  surf_h(2)%start_index
2575                      l = 2
2576                   CASE ( 'surf_h(2)%end_index' )   
2577                      IF ( kk == 1 )                                           &
2578                         READ ( 13 )  surf_h(2)%end_index
2579                   CASE ( 'surf_h(2)%us' )         
2580                      IF ( ALLOCATED( surf_h(2)%us )  .AND.  kk == 1 )         &
2581                         READ ( 13 )  surf_h(2)%us
2582                   CASE ( 'surf_h(2)%ts' )         
2583                      IF ( ALLOCATED( surf_h(2)%ts )  .AND.  kk == 1 )         &
2584                         READ ( 13 )  surf_h(2)%ts
2585                   CASE ( 'surf_h(2)%qs' )       
2586                      IF ( ALLOCATED( surf_h(2)%qs )  .AND.  kk == 1 )         &
2587                         READ ( 13 )  surf_h(2)%qs
2588                   CASE ( 'surf_h(2)%ss' )         
2589                      IF ( ALLOCATED( surf_h(2)%ss )  .AND.  kk == 1 )         &
2590                         READ ( 13 )  surf_h(2)%ss
2591                   CASE ( 'surf_h(2)%qcs' )         
2592                      IF ( ALLOCATED( surf_h(2)%qcs )  .AND.  kk == 1 )        &
2593                         READ ( 13 )  surf_h(2)%qcs
2594                   CASE ( 'surf_h(2)%ncs' )         
2595                      IF ( ALLOCATED( surf_h(2)%ncs )  .AND.  kk == 1 )        &
2596                         READ ( 13 )  surf_h(2)%ncs
2597                   CASE ( 'surf_h(2)%qrs' )         
2598                      IF ( ALLOCATED( surf_h(2)%qrs )  .AND.  kk == 1 )        &
2599                         READ ( 13 )  surf_h(2)%qrs
2600                   CASE ( 'surf_h(2)%nrs' )         
2601                      IF ( ALLOCATED( surf_h(2)%nrs )  .AND.  kk == 1 )        &
2602                         READ ( 13 )  surf_h(2)%nrs
2603                   CASE ( 'surf_h(2)%ol' )         
2604                      IF ( ALLOCATED( surf_h(2)%ol )  .AND.  kk == 1 )         &
2605                         READ ( 13 )  surf_h(2)%ol
2606                   CASE ( 'surf_h(2)%rib' )         
2607                      IF ( ALLOCATED( surf_h(2)%rib )  .AND.  kk == 1 )        &
2608                         READ ( 13 )  surf_h(2)%rib
2609                   CASE ( 'surf_h(2)%usws' )         
2610                      IF ( ALLOCATED( surf_h(2)%usws )  .AND.  kk == 1 )       &
2611                         READ ( 13 )  surf_h(2)%usws
2612                   CASE ( 'surf_h(2)%vsws' )         
2613                      IF ( ALLOCATED( surf_h(2)%vsws )  .AND.  kk == 1 )       &
2614                         READ ( 13 )  surf_h(2)%vsws
2615                   CASE ( 'surf_h(2)%shf' )         
2616                      IF ( ALLOCATED( surf_h(2)%shf )  .AND.  kk == 1 )        &
2617                         READ ( 13 )  surf_h(2)%shf
2618                   CASE ( 'surf_h(2)%qsws' )         
2619                      IF ( ALLOCATED( surf_h(2)%qsws )  .AND.  kk == 1 )       &
2620                         READ ( 13 )  surf_h(2)%qsws
2621                   CASE ( 'surf_h(2)%ssws' )         
2622                      IF ( ALLOCATED( surf_h(2)%ssws )  .AND.  kk == 1 )       &
2623                         READ ( 13 )  surf_h(2)%ssws
2624                   CASE ( 'surf_h(2)%qcsws' )         
2625                      IF ( ALLOCATED( surf_h(2)%qcsws )  .AND.  kk == 1 )      &
2626                         READ ( 13 )  surf_h(2)%qcsws
2627                   CASE ( 'surf_h(2)%ncsws' )         
2628                      IF ( ALLOCATED( surf_h(2)%ncsws )  .AND.  kk == 1 )      &
2629                         READ ( 13 )  surf_h(2)%ncsws
2630                   CASE ( 'surf_h(2)%qrsws' )         
2631                      IF ( ALLOCATED( surf_h(2)%qrsws )  .AND.  kk == 1 )      &
2632                         READ ( 13 )  surf_h(2)%qrsws
2633                   CASE ( 'surf_h(2)%nrsws' )         
2634                      IF ( ALLOCATED( surf_h(2)%nrsws )  .AND.  kk == 1 )      &
2635                         READ ( 13 )  surf_h(2)%nrsws
2636                   CASE ( 'surf_h(2)%sasws' )         
2637                      IF ( ALLOCATED( surf_h(2)%sasws )  .AND.  kk == 1 )      &
2638                         READ ( 13 )  surf_h(2)%sasws
2639
2640                   CASE ( 'surf_v(0)%start_index' )   
2641                      IF ( kk == 1 )                                           &
2642                         READ ( 13 )  surf_v(0)%start_index
2643                      l = 0
2644                      horizontal_surface = .FALSE.
2645                      vertical_surface   = .TRUE.
2646                   CASE ( 'surf_v(0)%end_index' )   
2647                      IF ( kk == 1 )                                           &
2648                         READ ( 13 )  surf_v(0)%end_index
2649                   CASE ( 'surf_v(0)%us' )         
2650                      IF ( ALLOCATED( surf_v(0)%us )  .AND.  kk == 1 )         &
2651                         READ ( 13 )  surf_v(0)%us
2652                   CASE ( 'surf_v(0)%ts' )         
2653                      IF ( ALLOCATED( surf_v(0)%ts )  .AND.  kk == 1 )         &
2654                         READ ( 13 )  surf_v(0)%ts
2655                   CASE ( 'surf_v(0)%qs' )         
2656                      IF ( ALLOCATED( surf_v(0)%qs )  .AND.  kk == 1 )         &
2657                         READ ( 13 )  surf_v(0)%qs
2658                   CASE ( 'surf_v(0)%ss' )         
2659                      IF ( ALLOCATED( surf_v(0)%ss )  .AND.  kk == 1 )         &
2660                         READ ( 13 )  surf_v(0)%ss
2661                   CASE ( 'surf_v(0)%qcs' )         
2662                      IF ( ALLOCATED( surf_v(0)%qcs )  .AND.  kk == 1 )        &
2663                         READ ( 13 )  surf_v(0)%qcs
2664                   CASE ( 'surf_v(0)%ncs' )         
2665                      IF ( ALLOCATED( surf_v(0)%ncs )  .AND.  kk == 1 )        &
2666                         READ ( 13 )  surf_v(0)%ncs
2667                   CASE ( 'surf_v(0)%qrs' )         
2668                      IF ( ALLOCATED( surf_v(0)%qrs )  .AND.  kk == 1 )        &
2669                         READ ( 13 )  surf_v(0)%qrs
2670                   CASE ( 'surf_v(0)%nrs' )         
2671                      IF ( ALLOCATED( surf_v(0)%nrs )  .AND.  kk == 1 )        &
2672                         READ ( 13 )  surf_v(0)%nrs
2673                   CASE ( 'surf_v(0)%ol' )         
2674                      IF ( ALLOCATED( surf_v(0)%ol )  .AND.  kk == 1 )         &
2675                         READ ( 13 )  surf_v(0)%ol
2676                   CASE ( 'surf_v(0)%rib' )         
2677                      IF ( ALLOCATED( surf_v(0)%rib )  .AND.  kk == 1 )        &
2678                         READ ( 13 )  surf_v(0)%rib
2679                   CASE ( 'surf_v(0)%shf' )         
2680                      IF ( ALLOCATED( surf_v(0)%shf )  .AND.  kk == 1 )        &
2681                         READ ( 13 )  surf_v(0)%shf
2682                   CASE ( 'surf_v(0)%qsws' )         
2683                      IF ( ALLOCATED( surf_v(0)%qsws )  .AND.  kk == 1 )       &
2684                         READ ( 13 )  surf_v(0)%qsws
2685                   CASE ( 'surf_v(0)%ssws' )         
2686                      IF ( ALLOCATED( surf_v(0)%ssws )  .AND.  kk == 1 )       &
2687                         READ ( 13 )  surf_v(0)%ssws
2688                   CASE ( 'surf_v(0)%qcsws' )         
2689                      IF ( ALLOCATED( surf_v(0)%qcsws )  .AND.  kk == 1 )      &
2690                         READ ( 13 )  surf_v(0)%qcsws
2691                   CASE ( 'surf_v(0)%ncsws' )         
2692                      IF ( ALLOCATED( surf_v(0)%ncsws )  .AND.  kk == 1 )      &
2693                         READ ( 13 )  surf_v(0)%ncsws
2694                   CASE ( 'surf_v(0)%qrsws' )         
2695                      IF ( ALLOCATED( surf_v(0)%qrsws )  .AND.  kk == 1 )      &
2696                         READ ( 13 )  surf_v(0)%qrsws
2697                   CASE ( 'surf_v(0)%nrsws' )         
2698                      IF ( ALLOCATED( surf_v(0)%nrsws )  .AND.  kk == 1 )      &
2699                         READ ( 13 )  surf_v(0)%nrsws
2700                   CASE ( 'surf_v(0)%sasws' )         
2701                      IF ( ALLOCATED( surf_v(0)%sasws )  .AND.  kk == 1 )      &
2702                         READ ( 13 )  surf_v(0)%sasws
2703                   CASE ( 'surf_v(0)%mom_uv' )         
2704                      IF ( ALLOCATED( surf_v(0)%mom_flux_uv )  .AND.  kk == 1 )&
2705                         READ ( 13 )  surf_v(0)%mom_flux_uv
2706                   CASE ( 'surf_v(0)%mom_w' )         
2707                      IF ( ALLOCATED( surf_v(0)%mom_flux_w )  .AND.  kk == 1 ) &
2708                         READ ( 13 )  surf_v(0)%mom_flux_w
2709                   CASE ( 'surf_v(0)%mom_tke' )         
2710                      IF ( ALLOCATED( surf_v(0)%mom_flux_tke )  .AND.  kk == 1 )&
2711                         READ ( 13 )  surf_v(0)%mom_flux_tke
2712
2713                   CASE ( 'surf_v(1)%start_index' )   
2714                      IF ( kk == 1 )                                           &
2715                         READ ( 13 )  surf_v(1)%start_index
2716                      l = 1
2717                   CASE ( 'surf_v(1)%end_index' )   
2718                      IF ( kk == 1 )                                           &
2719                         READ ( 13 )  surf_v(1)%end_index
2720                   CASE ( 'surf_v(1)%us' )         
2721                      IF ( ALLOCATED( surf_v(1)%us )  .AND.  kk == 1 )         &
2722                         READ ( 13 )  surf_v(1)%us
2723                   CASE ( 'surf_v(1)%ts' )         
2724                      IF ( ALLOCATED( surf_v(1)%ts )  .AND.  kk == 1 )         &
2725                         READ ( 13 )  surf_v(1)%ts
2726                   CASE ( 'surf_v(1)%qs' )         
2727                      IF ( ALLOCATED( surf_v(1)%qs )  .AND.  kk == 1 )         &
2728                         READ ( 13 )  surf_v(1)%qs
2729                   CASE ( 'surf_v(1)%ss' )         
2730                      IF ( ALLOCATED( surf_v(1)%ss )  .AND.  kk == 1 )         &
2731                         READ ( 13 )  surf_v(1)%ss
2732                   CASE ( 'surf_v(1)%qcs' )         
2733                      IF ( ALLOCATED( surf_v(1)%qcs )  .AND.  kk == 1 )        &
2734                         READ ( 13 )  surf_v(1)%qcs
2735                   CASE ( 'surf_v(1)%ncs' )         
2736                      IF ( ALLOCATED( surf_v(1)%ncs )  .AND.  kk == 1 )        &
2737                         READ ( 13 )  surf_v(1)%ncs
2738                   CASE ( 'surf_v(1)%qrs' )         
2739                      IF ( ALLOCATED( surf_v(1)%qrs )  .AND.  kk == 1 )        &
2740                         READ ( 13 )  surf_v(1)%qrs
2741                   CASE ( 'surf_v(1)%nrs' )         
2742                      IF ( ALLOCATED( surf_v(1)%nrs )  .AND.  kk == 1 )        &
2743                         READ ( 13 )  surf_v(1)%nrs
2744                   CASE ( 'surf_v(1)%ol' )         
2745                      IF ( ALLOCATED( surf_v(1)%ol )  .AND.  kk == 1 )         &
2746                         READ ( 13 )  surf_v(1)%ol
2747                   CASE ( 'surf_v(1)%rib' )         
2748                      IF ( ALLOCATED( surf_v(1)%rib )  .AND.  kk == 1 )        &
2749                         READ ( 13 )  surf_v(1)%rib
2750                   CASE ( 'surf_v(1)%shf' )         
2751                      IF ( ALLOCATED( surf_v(1)%shf )  .AND.  kk == 1 )        &
2752                         READ ( 13 )  surf_v(1)%shf
2753                   CASE ( 'surf_v(1)%qsws' )         
2754                      IF ( ALLOCATED( surf_v(1)%qsws )  .AND.  kk == 1 )       &
2755                         READ ( 13 )  surf_v(1)%qsws
2756                   CASE ( 'surf_v(1)%ssws' )         
2757                      IF ( ALLOCATED( surf_v(1)%ssws )  .AND.  kk == 1 )       &
2758                         READ ( 13 )  surf_v(1)%ssws
2759                   CASE ( 'surf_v(1)%qcsws' )         
2760                      IF ( ALLOCATED( surf_v(1)%qcsws )  .AND.  kk == 1 )      &
2761                         READ ( 13 )  surf_v(1)%qcsws
2762                   CASE ( 'surf_v(1)%ncsws' )         
2763                      IF ( ALLOCATED( surf_v(1)%ncsws )  .AND.  kk == 1 )      &
2764                         READ ( 13 )  surf_v(1)%ncsws
2765                   CASE ( 'surf_v(1)%qrsws' )         
2766                      IF ( ALLOCATED( surf_v(1)%qrsws )  .AND.  kk == 1 )      &
2767                         READ ( 13 )  surf_v(1)%qrsws
2768                   CASE ( 'surf_v(1)%nrsws' )         
2769                      IF ( ALLOCATED( surf_v(1)%nrsws )  .AND.  kk == 1 )      &
2770                         READ ( 13 )  surf_v(1)%nrsws
2771                   CASE ( 'surf_v(1)%sasws' )         
2772                      IF ( ALLOCATED( surf_v(1)%sasws )  .AND.  kk == 1 )      &
2773                         READ ( 13 )  surf_v(1)%sasws
2774                   CASE ( 'surf_v(1)%mom_uv' )         
2775                      IF ( ALLOCATED( surf_v(1)%mom_flux_uv )  .AND.  kk == 1 )&
2776                         READ ( 13 )  surf_v(1)%mom_flux_uv
2777                   CASE ( 'surf_v(1)%mom_w' )         
2778                      IF ( ALLOCATED( surf_v(1)%mom_flux_w )  .AND.  kk == 1 ) &
2779                         READ ( 13 )  surf_v(1)%mom_flux_w
2780                   CASE ( 'surf_v(1)%mom_tke' )         
2781                      IF ( ALLOCATED( surf_v(1)%mom_flux_tke )  .AND.  kk == 1 )&
2782                         READ ( 13 )  surf_v(1)%mom_flux_tke
2783
2784                   CASE ( 'surf_v(2)%start_index' )   
2785                      IF ( kk == 1 )                                           &
2786                         READ ( 13 )  surf_v(2)%start_index
2787                      l = 2
2788                   CASE ( 'surf_v(2)%end_index' )   
2789                      IF ( kk == 1 )                                           &
2790                         READ ( 13 )  surf_v(2)%end_index
2791                   CASE ( 'surf_v(2)%us' )         
2792                      IF ( ALLOCATED( surf_v(2)%us )  .AND.  kk == 1 )         &
2793                         READ ( 13 )  surf_v(2)%us
2794                   CASE ( 'surf_v(2)%ts' )         
2795                      IF ( ALLOCATED( surf_v(2)%ts )  .AND.  kk == 1 )         &
2796                         READ ( 13 )  surf_v(2)%ts
2797                   CASE ( 'surf_v(2)%qs' )         
2798                      IF ( ALLOCATED( surf_v(2)%qs )  .AND.  kk == 1 )         &
2799                         READ ( 13 )  surf_v(2)%qs
2800                   CASE ( 'surf_v(2)%ss' )         
2801                      IF ( ALLOCATED( surf_v(2)%ss )  .AND.  kk == 1 )         &
2802                         READ ( 13 )  surf_v(2)%ss
2803                   CASE ( 'surf_v(2)%qcs' )         
2804                      IF ( ALLOCATED( surf_v(2)%qcs )  .AND.  kk == 1 )        &
2805                         READ ( 13 )  surf_v(2)%qcs
2806                   CASE ( 'surf_v(2)%ncs' )         
2807                      IF ( ALLOCATED( surf_v(2)%ncs )  .AND.  kk == 1 )        &
2808                         READ ( 13 )  surf_v(2)%ncs
2809                   CASE ( 'surf_v(2)%qrs' )         
2810                      IF ( ALLOCATED( surf_v(2)%qrs )  .AND.  kk == 1 )        &
2811                         READ ( 13 )  surf_v(2)%qrs
2812                   CASE ( 'surf_v(2)%nrs' )         
2813                      IF ( ALLOCATED( surf_v(2)%nrs )  .AND.  kk == 1 )        &
2814                         READ ( 13 )  surf_v(2)%nrs
2815                   CASE ( 'surf_v(2)%ol' )         
2816                      IF ( ALLOCATED( surf_v(2)%ol )  .AND.  kk == 1 )         &
2817                         READ ( 13 )  surf_v(2)%ol
2818                   CASE ( 'surf_v(2)%rib' )         
2819                      IF ( ALLOCATED( surf_v(2)%rib )  .AND.  kk == 1 )        &
2820                         READ ( 13 )  surf_v(2)%rib
2821                   CASE ( 'surf_v(2)%shf' )         
2822                      IF ( ALLOCATED( surf_v(2)%shf )  .AND.  kk == 1 )        &
2823                         READ ( 13 )  surf_v(2)%shf
2824                   CASE ( 'surf_v(2)%qsws' )         
2825                      IF ( ALLOCATED( surf_v(2)%qsws )  .AND.  kk == 1 )       &
2826                         READ ( 13 )  surf_v(2)%qsws
2827                   CASE ( 'surf_v(2)%ssws' )         
2828                      IF ( ALLOCATED( surf_v(2)%ssws )  .AND.  kk == 1 )       &
2829                         READ ( 13 )  surf_v(2)%ssws
2830                   CASE ( 'surf_v(2)%qcsws' )         
2831                      IF ( ALLOCATED( surf_v(2)%qcsws )  .AND.  kk == 1 )      &
2832                         READ ( 13 )  surf_v(2)%qcsws
2833                   CASE ( 'surf_v(2)%ncsws' )         
2834                      IF ( ALLOCATED( surf_v(2)%ncsws )  .AND.  kk == 1 )      &
2835                         READ ( 13 )  surf_v(2)%ncsws
2836                   CASE ( 'surf_v(2)%qrsws' )         
2837                      IF ( ALLOCATED( surf_v(2)%qrsws )  .AND.  kk == 1 )      &
2838                         READ ( 13 )  surf_v(2)%qrsws
2839                   CASE ( 'surf_v(2)%nrsws' )         
2840                      IF ( ALLOCATED( surf_v(2)%nrsws )  .AND.  kk == 1 )      &
2841                         READ ( 13 )  surf_v(2)%nrsws
2842                   CASE ( 'surf_v(2)%sasws' )         
2843                      IF ( ALLOCATED( surf_v(2)%sasws )  .AND.  kk == 1 )      &
2844                         READ ( 13 )  surf_v(2)%sasws
2845                   CASE ( 'surf_v(2)%mom_uv' )         
2846                      IF ( ALLOCATED( surf_v(2)%mom_flux_uv )  .AND.  kk == 1 )&
2847                         READ ( 13 )  surf_v(2)%mom_flux_uv
2848                   CASE ( 'surf_v(2)%mom_w' )         
2849                      IF ( ALLOCATED( surf_v(2)%mom_flux_w )  .AND.  kk == 1 ) &
2850                         READ ( 13 )  surf_v(2)%mom_flux_w
2851                   CASE ( 'surf_v(2)%mom_tke' )         
2852                      IF ( ALLOCATED( surf_v(2)%mom_flux_tke )  .AND.  kk == 1 )&
2853                         READ ( 13 )  surf_v(2)%mom_flux_tke
2854
2855                   CASE ( 'surf_v(3)%start_index' )   
2856                      IF ( kk == 1 )                                           &
2857                         READ ( 13 )  surf_v(3)%start_index
2858                      l = 3
2859                   CASE ( 'surf_v(3)%end_index' )   
2860                      IF ( kk == 1 )                                           &
2861                         READ ( 13 )  surf_v(3)%end_index
2862                   CASE ( 'surf_v(3)%us' )         
2863                      IF ( ALLOCATED( surf_v(3)%us )  .AND.  kk == 1 )         &
2864                         READ ( 13 )  surf_v(3)%us
2865                   CASE ( 'surf_v(3)%ts' )         
2866                      IF ( ALLOCATED( surf_v(3)%ts )  .AND.  kk == 1 )         &
2867                         READ ( 13 )  surf_v(3)%ts
2868                   CASE ( 'surf_v(3)%qs' )       
2869                      IF ( ALLOCATED( surf_v(3)%qs )  .AND.  kk == 1 )         &
2870                         READ ( 13 )  surf_v(3)%qs
2871                   CASE ( 'surf_v(3)%ss' )         
2872                      IF ( ALLOCATED( surf_v(3)%ss )  .AND.  kk == 1 )         &
2873                         READ ( 13 )  surf_v(3)%ss
2874                   CASE ( 'surf_v(3)%qcs' )         
2875                      IF ( ALLOCATED( surf_v(3)%qcs )  .AND.  kk == 1 )        &
2876                         READ ( 13 )  surf_v(3)%qcs
2877                   CASE ( 'surf_v(3)%ncs' )         
2878                      IF ( ALLOCATED( surf_v(3)%ncs )  .AND.  kk == 1 )        &
2879                         READ ( 13 )  surf_v(3)%ncs
2880                   CASE ( 'surf_v(3)%qrs' )         
2881                      IF ( ALLOCATED( surf_v(3)%qrs )  .AND.  kk == 1 )        &
2882                         READ ( 13 )  surf_v(3)%qrs
2883                   CASE ( 'surf_v(3)%nrs' )         
2884                      IF ( ALLOCATED( surf_v(3)%nrs )  .AND.  kk == 1 )        &
2885                         READ ( 13 )  surf_v(3)%nrs
2886                   CASE ( 'surf_v(3)%ol' )         
2887                      IF ( ALLOCATED( surf_v(3)%ol )  .AND.  kk == 1 )         &
2888                         READ ( 13 )  surf_v(3)%ol
2889                   CASE ( 'surf_v(3)%rib' )         
2890                      IF ( ALLOCATED( surf_v(3)%rib )  .AND.  kk == 1 )        &
2891                         READ ( 13 )  surf_v(3)%rib
2892                   CASE ( 'surf_v(3)%shf' )         
2893                      IF ( ALLOCATED( surf_v(3)%shf )  .AND.  kk == 1 )        &
2894                         READ ( 13 )  surf_v(3)%shf
2895                   CASE ( 'surf_v(3)%qsws' )         
2896                      IF ( ALLOCATED( surf_v(3)%qsws )  .AND.  kk == 1 )       &
2897                         READ ( 13 )  surf_v(3)%qsws
2898                   CASE ( 'surf_v(3)%ssws' )         
2899                      IF ( ALLOCATED( surf_v(3)%ssws )  .AND.  kk == 1 )       &
2900                         READ ( 13 )  surf_v(3)%ssws
2901                   CASE ( 'surf_v(3)%qcsws' )         
2902                      IF ( ALLOCATED( surf_v(3)%qcsws )  .AND.  kk == 1 )      &
2903                         READ ( 13 )  surf_v(3)%qcsws
2904                   CASE ( 'surf_v(3)%ncsws' )         
2905                      IF ( ALLOCATED( surf_v(3)%ncsws )  .AND.  kk == 1 )      &
2906                         READ ( 13 )  surf_v(3)%ncsws
2907                   CASE ( 'surf_v(3)%qrsws' )         
2908                      IF ( ALLOCATED( surf_v(3)%qrsws )  .AND.  kk == 1 )      &
2909                         READ ( 13 )  surf_v(3)%qrsws
2910                   CASE ( 'surf_v(3)%nrsws' )         
2911                      IF ( ALLOCATED( surf_v(3)%nrsws )  .AND.  kk == 1 )      &
2912                         READ ( 13 )  surf_v(3)%nrsws
2913                   CASE ( 'surf_v(3)%sasws' )         
2914                      IF ( ALLOCATED( surf_v(3)%sasws )  .AND.  kk == 1 )      &
2915                         READ ( 13 )  surf_v(3)%sasws
2916                   CASE ( 'surf_v(3)%mom_uv' )         
2917                      IF ( ALLOCATED( surf_v(3)%mom_flux_uv )  .AND.  kk == 1 )&
2918                         READ ( 13 )  surf_v(3)%mom_flux_uv
2919                   CASE ( 'surf_v(3)%mom_w' )         
2920                      IF ( ALLOCATED( surf_v(3)%mom_flux_w )  .AND.  kk == 1 ) &
2921                         READ ( 13 )  surf_v(3)%mom_flux_w
2922                   CASE ( 'surf_v(3)%mom_tke' )         
2923                      IF ( ALLOCATED( surf_v(3)%mom_flux_tke )  .AND.  kk == 1 )&
2924                         READ ( 13 )  surf_v(3)%mom_flux_tke
2925
2926                END SELECT
2927!
2928!--             Redistribute surface elements on its respective type.
2929                IF ( horizontal_surface )  THEN
2930                   ic = nxlc
2931                   DO  i = nxlf, nxrf
2932                      jc = nysc
2933                      DO  j = nysf, nynf
2934
2935                         surf_match_def  = surf_def_h(l)%end_index(jc,ic) >=   &
2936                                           surf_def_h(l)%start_index(jc,ic)
2937                         surf_match_lsm  = surf_lsm_h%end_index(jc,ic)    >=   &
2938                                           surf_lsm_h%start_index(jc,ic)
2939                         surf_match_usm  = surf_usm_h%end_index(jc,ic)    >=   &
2940                                           surf_usm_h%start_index(jc,ic)
2941
2942                         IF ( surf_match_def )  THEN
2943                            mm = surf_def_h(l)%start_index(jc,ic)
2944                            DO  m = surf_h(l)%start_index(j,i),                &
2945                                    surf_h(l)%end_index(j,i)
2946                               CALL restore_surface_elements( surf_def_h(l),   &
2947                                                              mm, surf_h(l), m )
2948                               mm = mm + 1
2949                            ENDDO
2950                         ENDIF
2951
2952                         IF ( surf_match_lsm )  THEN
2953                            mm = surf_lsm_h%start_index(jc,ic)
2954                            DO  m = surf_h(l)%start_index(j,i),                &
2955                                    surf_h(l)%end_index(j,i)
2956                               CALL restore_surface_elements( surf_lsm_h,      &
2957                                                              mm, surf_h(l), m )
2958                               mm = mm + 1
2959                            ENDDO
2960                         ENDIF
2961
2962                         IF ( surf_match_usm )  THEN
2963                            mm = surf_usm_h%start_index(jc,ic)
2964                            DO  m = surf_h(l)%start_index(j,i),                &
2965                                    surf_h(l)%end_index(j,i)
2966                               CALL restore_surface_elements( surf_usm_h,      &
2967                                                              mm, surf_h(l), m )
2968                               mm = mm + 1
2969                            ENDDO
2970                         ENDIF
2971
2972                         jc = jc + 1
2973                      ENDDO
2974                      ic = ic + 1
2975                   ENDDO
2976                ELSEIF ( vertical_surface )  THEN
2977                   ic = nxlc
2978                   DO  i = nxlf, nxrf
2979                      jc = nysc
2980                      DO  j = nysf, nynf
2981
2982                         surf_match_def  = surf_def_v(l)%end_index(jc,ic) >=   &
2983                                           surf_def_v(l)%start_index(jc,ic)
2984                         surf_match_lsm  = surf_lsm_v(l)%end_index(jc,ic) >=   &
2985                                           surf_lsm_v(l)%start_index(jc,ic)
2986                         surf_match_usm  = surf_usm_v(l)%end_index(jc,ic) >=   &
2987                                           surf_usm_v(l)%start_index(jc,ic)
2988
2989
2990
2991                         IF ( surf_match_def )  THEN
2992                            mm = surf_def_v(l)%start_index(jc,ic)
2993                            DO  m = surf_v(l)%start_index(j,i),                &
2994                                    surf_v(l)%end_index(j,i)
2995                               CALL restore_surface_elements( surf_def_v(l),   &
2996                                                              mm, surf_v(l), m )
2997                               mm = mm + 1
2998                            ENDDO
2999                         ENDIF
3000
3001                         IF ( surf_match_lsm )  THEN
3002                            mm = surf_lsm_v(l)%start_index(jc,ic)
3003                            DO  m = surf_v(l)%start_index(j,i),                &
3004                                    surf_v(l)%end_index(j,i)
3005                               CALL restore_surface_elements( surf_lsm_v(l),   &
3006                                                              mm, surf_v(l), m )
3007                               mm = mm + 1
3008                            ENDDO
3009                         ENDIF
3010   
3011                         IF ( surf_match_usm )  THEN
3012                            mm = surf_usm_v(l)%start_index(jc,ic)
3013                            DO  m = surf_v(l)%start_index(j,i),                &
3014                                    surf_v(l)%end_index(j,i)
3015                               CALL restore_surface_elements( surf_usm_v(l),   &
3016                                                              mm, surf_v(l), m )
3017                               mm = mm + 1
3018                            ENDDO
3019                         ENDIF
3020
3021                         jc = jc + 1
3022                      ENDDO
3023                      ic = ic + 1
3024                   ENDDO
3025                ENDIF
3026
3027             ENDDO
3028
3029             READ ( 13 )  field_chr
3030
3031          ENDDO
3032
3033       ENDIF
3034
3035
3036       CONTAINS
3037!------------------------------------------------------------------------------!
3038! Description:
3039! ------------
3040!> Restores surfacle elements back on its respective type.
3041!------------------------------------------------------------------------------!
3042          SUBROUTINE restore_surface_elements( surf_target, m_target,          &
3043                                               surf_file,   m_file )
3044
3045             IMPLICIT NONE
3046
3047             INTEGER(iwp)      ::  m_file      !< respective surface-element index of current surface array
3048             INTEGER(iwp)      ::  m_target    !< respecitve surface-element index of surface array on file
3049
3050             TYPE( surf_type ) ::  surf_target !< target surface type
3051             TYPE( surf_type ) ::  surf_file   !< surface type on file
3052
3053             IF ( SCAN( TRIM( field_chr ), '%us' ) /= 0 )  THEN
3054                IF ( ALLOCATED( surf_target%us )  .AND.                        &
3055                     ALLOCATED( surf_file%us   ) )                             & 
3056                   surf_target%us(m_target) = surf_file%us(m_file)
3057             ENDIF
3058
3059             IF ( SCAN( TRIM( field_chr ), '%ol' ) /= 0 )  THEN
3060                IF ( ALLOCATED( surf_target%ol )  .AND.                        &
3061                     ALLOCATED( surf_file%ol   ) )                             & 
3062                   surf_target%ol(m_target) = surf_file%ol(m_file)
3063             ENDIF
3064
3065             IF ( SCAN( TRIM( field_chr ), '%usws' ) /= 0 )  THEN
3066                IF ( ALLOCATED( surf_target%usws )  .AND.                      &
3067                     ALLOCATED( surf_file%usws   ) )                           & 
3068                   surf_target%usws(m_target) = surf_file%usws(m_file)
3069             ENDIF
3070
3071             IF ( SCAN( TRIM( field_chr ), '%vsws' ) /= 0 )  THEN
3072                IF ( ALLOCATED( surf_target%vsws )  .AND.                      &
3073                     ALLOCATED( surf_file%vsws   ) )                           & 
3074                   surf_target%vsws(m_target) = surf_file%vsws(m_file)
3075             ENDIF
3076
3077             IF ( SCAN( TRIM( field_chr ), '%ts' ) /= 0 )  THEN
3078                IF ( ALLOCATED( surf_target%ts )  .AND.                        &
3079                     ALLOCATED( surf_file%ts   ) )                             & 
3080                   surf_target%ts(m_target) = surf_file%ts(m_file)
3081             ENDIF
3082
3083             IF ( SCAN( TRIM( field_chr ), '%shf' ) /= 0 )  THEN
3084                IF ( ALLOCATED( surf_target%shf )  .AND.                       &
3085                     ALLOCATED( surf_file%shf   ) )                            & 
3086                   surf_target%shf(m_target) = surf_file%shf(m_file)
3087             ENDIF
3088
3089             IF ( SCAN( TRIM( field_chr ), '%qs' ) /= 0 )  THEN
3090                IF ( ALLOCATED( surf_target%qs )  .AND.                        &
3091                     ALLOCATED( surf_file%qs   ) )                             & 
3092                   surf_target%qs(m_target) = surf_file%qs(m_file)
3093             ENDIF
3094
3095             IF ( SCAN( TRIM( field_chr ), '%qsws' ) /= 0 )  THEN
3096                IF ( ALLOCATED( surf_target%qsws )  .AND.                      &
3097                     ALLOCATED( surf_file%qsws   ) )                           & 
3098                   surf_target%qsws(m_target) = surf_file%qsws(m_file)
3099             ENDIF
3100
3101             IF ( SCAN( TRIM( field_chr ), '%ss' ) /= 0 )  THEN
3102                IF ( ALLOCATED( surf_target%ss )  .AND.                        &
3103                     ALLOCATED( surf_file%ss   ) )                             & 
3104                   surf_target%ss(m_target) = surf_file%ss(m_file)
3105             ENDIF
3106
3107             IF ( SCAN( TRIM( field_chr ), '%ssws' ) /= 0 )  THEN
3108                IF ( ALLOCATED( surf_target%ssws )  .AND.                      &
3109                     ALLOCATED( surf_file%ssws   ) )                           & 
3110                   surf_target%ssws(m_target) = surf_file%ssws(m_file)
3111             ENDIF
3112
3113             IF ( SCAN( TRIM( field_chr ), '%qcs' ) /= 0 )  THEN
3114                IF ( ALLOCATED( surf_target%qcs )  .AND.                       &
3115                     ALLOCATED( surf_file%qcs   ) )                            & 
3116                  surf_target%qcs(m_target) = surf_file%qcs(m_file)
3117             ENDIF
3118
3119             IF ( SCAN( TRIM( field_chr ), '%qcsws' ) /= 0 )  THEN
3120                IF ( ALLOCATED( surf_target%qcsws )  .AND.                     &
3121                     ALLOCATED( surf_file%qcsws   ) )                          & 
3122                   surf_target%qcsws(m_target) = surf_file%qcsws(m_file)
3123             ENDIF
3124
3125             IF ( SCAN( TRIM( field_chr ), '%ncs' ) /= 0 )  THEN
3126                IF ( ALLOCATED( surf_target%ncs )  .AND.                       &
3127                     ALLOCATED( surf_file%ncs   ) )                            & 
3128                   surf_target%ncs(m_target) = surf_file%ncs(m_file)
3129             ENDIF
3130
3131             IF ( SCAN( TRIM( field_chr ), '%ncsws' ) /= 0 )  THEN
3132                IF ( ALLOCATED( surf_target%ncsws )  .AND.                     &
3133                     ALLOCATED( surf_file%ncsws   ) )                          & 
3134                   surf_target%ncsws(m_target) = surf_file%ncsws(m_file)
3135             ENDIF
3136
3137             IF ( SCAN( TRIM( field_chr ), '%qrs' ) /= 0 )  THEN
3138                IF ( ALLOCATED( surf_target%qrs )  .AND.                       &
3139                     ALLOCATED( surf_file%qrs   ) )                            & 
3140                  surf_target%qrs(m_target) = surf_file%qrs(m_file)
3141             ENDIF
3142
3143             IF ( SCAN( TRIM( field_chr ), '%qrsws' ) /= 0 )  THEN
3144                IF ( ALLOCATED( surf_target%qrsws )  .AND.                     &
3145                     ALLOCATED( surf_file%qrsws   ) )                          & 
3146                   surf_target%qrsws(m_target) = surf_file%qrsws(m_file)
3147             ENDIF
3148
3149             IF ( SCAN( TRIM( field_chr ), '%nrs' ) /= 0 )  THEN
3150                IF ( ALLOCATED( surf_target%nrs )  .AND.                       &
3151                     ALLOCATED( surf_file%nrs   ) )                            & 
3152                   surf_target%nrs(m_target) = surf_file%nrs(m_file)
3153             ENDIF
3154
3155             IF ( SCAN( TRIM( field_chr ), '%nrsws' ) /= 0 )  THEN
3156                IF ( ALLOCATED( surf_target%nrsws )  .AND.                     &
3157                     ALLOCATED( surf_file%nrsws   ) )                          & 
3158                   surf_target%nrsws(m_target) = surf_file%nrsws(m_file)
3159             ENDIF
3160
3161             IF ( SCAN( TRIM( field_chr ), '%sasws' ) /= 0 )  THEN
3162                IF ( ALLOCATED( surf_target%sasws )  .AND.                     &
3163                     ALLOCATED( surf_file%sasws   ) )                          & 
3164                   surf_target%sasws(m_target) = surf_file%sasws(m_file)
3165             ENDIF
3166
3167             IF ( SCAN( TRIM( field_chr ), '%mom_uv' ) /= 0 )  THEN
3168                IF ( ALLOCATED( surf_target%mom_flux_uv )  .AND.               &
3169                     ALLOCATED( surf_file%mom_flux_uv   ) )                    & 
3170                   surf_target%mom_flux_uv(m_target) =                         &
3171                                           surf_file%mom_flux_uv(m_file)
3172             ENDIF
3173
3174             IF ( SCAN( TRIM( field_chr ), '%mom_w' ) /= 0 )  THEN
3175                IF ( ALLOCATED( surf_target%mom_flux_w )  .AND.                &
3176                     ALLOCATED( surf_file%mom_flux_w   ) )                     & 
3177                   surf_target%mom_flux_w(m_target) =                          &
3178                                           surf_file%mom_flux_w(m_file)
3179             ENDIF
3180
3181             IF ( SCAN( TRIM( field_chr ), '%mom_tke' ) /= 0 )  THEN
3182                IF ( ALLOCATED( surf_target%mom_flux_tke )  .AND.              &
3183                     ALLOCATED( surf_file%mom_flux_tke   ) )                   & 
3184                   surf_target%mom_flux_tke(0:1,m_target) =                    &
3185                                           surf_file%mom_flux_tke(0:1,m_file)
3186             ENDIF
3187
3188          END SUBROUTINE restore_surface_elements
3189
3190    END SUBROUTINE surface_read_restart_data
3191
3192 
3193!------------------------------------------------------------------------------!
3194! Description:
3195! ------------
3196!> Counts the number of surface elements with the same facing, required for
3197!> reading and writing restart data.
3198!------------------------------------------------------------------------------!
3199    SUBROUTINE surface_last_actions
3200
3201       IMPLICIT NONE
3202!
3203!--    Horizontal surfaces
3204       ns_h_on_file(0) = surf_def_h(0)%ns + surf_lsm_h%ns + surf_usm_h%ns
3205       ns_h_on_file(1) = surf_def_h(1)%ns
3206       ns_h_on_file(2) = surf_def_h(2)%ns
3207!
3208!--    Vertical surfaces
3209       ns_v_on_file(0) = surf_def_v(0)%ns + surf_lsm_v(0)%ns + surf_usm_v(0)%ns
3210       ns_v_on_file(1) = surf_def_v(1)%ns + surf_lsm_v(1)%ns + surf_usm_v(1)%ns
3211       ns_v_on_file(2) = surf_def_v(2)%ns + surf_lsm_v(2)%ns + surf_usm_v(2)%ns
3212       ns_v_on_file(3) = surf_def_v(3)%ns + surf_lsm_v(3)%ns + surf_usm_v(3)%ns
3213
3214    END SUBROUTINE surface_last_actions
3215
3216
3217 END MODULE surface_mod
Note: See TracBrowser for help on using the repository browser.