source: palm/trunk/SOURCE/read_restart_data_mod.f90 @ 4617

Last change on this file since 4617 was 4617, checked in by raasch, 4 years ago

cyclic fill mode implemented for MPI-IO, check, if boundary conditions in the prerun are both set to cyclic

  • Property svn:keywords set to Id
File size: 116.6 KB
Line 
1!> @file read_restart_data_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2020 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: read_restart_data_mod.f90 4617 2020-07-22 09:48:50Z raasch $
27! check, if boundary conditions in the prerun are both set to cyclic
28!
29! 4590 2020-07-06 14:34:59Z suehring
30! Bugfix in allocation of hom and hom_sum in case of mpi-io restart when
31! chemistry or salsa are employed
32!
33! 4580 2020-06-29 07:54:21Z raasch
34! data handling with MPI-IO for cyclic-fill added (so far only for global data)
35!
36! 4564 2020-06-12 14:03:36Z raasch
37! Vertical nesting method of Huq et al. (2019) removed
38!
39! 4539 2020-05-18 14:05:17Z raasch
40! location message added
41!
42! 4536 2020-05-17 17:24:13Z raasch
43! binary version incremented
44!
45! 4534 2020-05-14 18:35:22Z raasch
46! adjustments for I/O on reduced number of cores using shared memory MPI
47!
48! 4518 2020-05-04 15:44:28Z suehring
49! Move input of diagnostic output quantities to doq_rrd_local
50!
51! 4517 2020-05-03 14:29:30Z raasch
52! qsurf and ssurf added
53!
54! 4498 2020-04-15 14:26:31Z raasch
55! argument removed from rd_mpi_io_open
56!
57! 4496 2020-04-15 08:37:26Z raasch
58! bugfix: MPI barrier removed, coupling character added to input filename
59!
60! 4495 2020-04-13 20:11:20Z raasch
61! restart data handling with MPI-IO added
62!
63! 4435 2020-03-03 10:38:41Z raasch
64! bugfix for message that reports about files that are read from in case that the virtual PE grid
65! has chenged (in case of large number of files format was exceeded), detailed messages about the
66! files are now output to the debug file
67!
68! 4431 2020-02-27 23:23:01Z gronemeier
69! added u_center_av, v_center_av, wspeed_av
70!
71! 4360 2020-01-07 11:25:50Z suehring
72! Change automatic arrays to allocatable ones in rrd_local, in order to avoid
73! memory problems due to too small stack size for large jobs with intel
74! compiler. (J.Resler)
75!
76! 4331 2019-12-10 18:25:02Z suehring
77! Enable restart data for 2-m potential temperature output
78!
79! 4301 2019-11-22 12:09:09Z oliver.maas
80! removed recycling_yshift
81!
82! 4227 2019-09-10 18:04:34Z gronemeier
83! implement new palm_date_time_mod and increased binary version
84!
85! 4146 2019-08-07 07:47:36Z gronemeier
86! Corrected "Former revisions" section
87!
88! 4131 2019-08-02 11:06:18Z monakurppa
89! Allocate hom and hom_sum to allow profile output for salsa variables.
90!
91! 4101 2019-07-17 15:14:26Z gronemeier
92! remove old_dt
93!
94! 4039 2019-06-18 10:32:41Z suehring
95! input of uu_av, vv_av, ww_av added
96!
97! 4017 2019-06-06 12:16:46Z schwenkel
98! bugfix for r3998, allocation of 3d temporary arrays of various dimensions revised
99!
100! 3998 2019-05-23 13:38:11Z suehring
101! Formatting adjustment
102!
103! 3994 2019-05-22 18:08:09Z suehring
104! output of turbulence intensity added
105!
106! 3988 2019-05-22 11:32:37Z kanani
107! + time_virtual_measurement (to enable steering of output interval)
108!
109! 3936 2019-04-26 15:38:02Z kanani
110! Enable time-averaged output of theta_2m* with restarts
111!
112! 3767 2019-02-27 08:18:02Z raasch
113! unused variables removed from rrd-subroutines parameter list
114!
115! 3766 2019-02-26 16:23:41Z raasch
116! first argument removed from module_interface_rrd_*
117!
118! 3668 2019-01-14 12:49:24Z maronga
119! Removed most_method and increased binary version
120!
121! 3655 2019-01-07 16:51:22Z knoop
122! Implementation of the PALM module interface
123!
124! 2894 2018-03-15 09:17:58Z Giersch
125! Initial revision
126!
127!
128! Description:
129! ------------
130!> Reads restart data from restart-file(s) (binary format).
131!>
132!> @todo: Revise max_pr_cs (profiles for chemistry)
133!> @todo: Modularize reading of restart data for diagnostic quantities, which
134!>        is not possible with the current module-interface structure
135!------------------------------------------------------------------------------!
136 MODULE read_restart_data_mod
137
138
139    USE arrays_3d,                                                             &
140        ONLY:  inflow_damping_factor, mean_inflow_profiles, pt_init,           &
141               q_init, ref_state, sa_init, s_init, u_init, ug, v_init, vg,     &
142               e, kh, km, p, pt, q, ql, s, u, u_m_l, u_m_n, u_m_r, u_m_s,      &
143               v, v_m_l, v_m_n, v_m_r, v_m_s, vpt, w, w_m_l, w_m_n, w_m_r, w_m_s
144
145    USE averaging
146
147    USE bulk_cloud_model_mod,                                                                      &
148        ONLY:  bulk_cloud_model
149
150    USE chem_modules,                                                                              &
151       ONLY: max_pr_cs
152
153    USE control_parameters
154
155    USE cpulog,                                                                &
156        ONLY:  cpu_log, log_point_s
157
158    USE grid_variables,                                                        &
159        ONLY:  dx, dy
160
161    USE gust_mod,                                                                                  &
162        ONLY:  gust_module_enabled
163
164    USE indices,                                                               &
165        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nx_on_file, ny, nys, nysg, nyn, &
166               nyng, ny_on_file, nz, nzb, nzt
167
168    USE kinds
169
170    USE model_1d_mod,                                                          &
171        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
172
173    USE module_interface,                                                      &
174        ONLY:  module_interface_rrd_global,                                    &
175               module_interface_rrd_local
176
177    USE netcdf_interface,                                                      &
178        ONLY:  netcdf_precision, output_for_t0
179
180    USE particle_attributes,                                                                       &
181        ONLY:  particle_advection
182
183    USE pegrid
184
185    USE radiation_model_mod,                                                   &
186        ONLY:  time_radiation
187
188    USE random_function_mod,                                                   &
189        ONLY:  random_iv, random_iy
190
191    USE random_generator_parallel,                                             &
192        ONLY:  id_random_array, seq_random_array
193
194    USE restart_data_mpi_io_mod,                                                                   &
195        ONLY:  rd_mpi_io_check_array, rd_mpi_io_close, rd_mpi_io_open, rrd_mpi_io,                 &
196               rrd_mpi_io_global_array
197
198    USE spectra_mod,                                                           &
199        ONLY:  average_count_sp, spectrum_x, spectrum_y
200
201    USE surface_mod,                                                           &
202        ONLY :  surface_rrd_local
203
204    USE statistics,                                                            &
205        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
206               v_max, v_max_ijk, w_max, w_max_ijk, z_i
207
208    USE user,                                                                                      &
209        ONLY:  user_module_enabled
210
211    USE virtual_measurement_mod,                                               &
212        ONLY:  time_virtual_measurement
213
214
215    IMPLICIT NONE
216
217
218    INTERFACE rrd_global
219       MODULE PROCEDURE rrd_global
220    END INTERFACE rrd_global
221
222    INTERFACE rrd_read_parts_of_global
223       MODULE PROCEDURE rrd_read_parts_of_global
224    END INTERFACE rrd_read_parts_of_global
225
226    INTERFACE rrd_local
227       MODULE PROCEDURE rrd_local
228    END INTERFACE rrd_local
229
230    INTERFACE rrd_skip_global
231       MODULE PROCEDURE rrd_skip_global
232    END INTERFACE rrd_skip_global
233
234
235    PUBLIC rrd_global, rrd_read_parts_of_global, rrd_local, rrd_skip_global
236
237
238 CONTAINS
239
240!------------------------------------------------------------------------------!
241! Description:
242! ------------
243!> Reads values of global control variables from restart-file (binary format)
244!> created by PE0 of the previous run
245!------------------------------------------------------------------------------!
246 SUBROUTINE rrd_global
247
248
249    CHARACTER(LEN=10) ::  binary_version_global  !<
250    CHARACTER(LEN=10) ::  version_on_file        !<
251    CHARACTER(LEN=20) ::  tmp_name               !< temporary variable
252
253    INTEGER ::  i                                !< loop index
254
255    LOGICAL ::  array_found                      !<
256    LOGICAL ::  found                            !<
257
258
259    CALL location_message( 'read global restart data', 'start' )
260
261    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
262!
263!--    Input in Fortran binary format
264       CALL check_open( 13 )
265!
266!--    Make version number check first
267       READ ( 13 )  length
268       READ ( 13 )  restart_string(1:length)
269       READ ( 13 )  version_on_file
270
271       binary_version_global = '5.0'
272       IF ( TRIM( version_on_file ) /= TRIM( binary_version_global ) )  THEN
273          WRITE( message_string, * ) 'version mismatch concerning ',           &
274                                     'binary_version_global:',                 &
275                                     '&version on file    = "',                &
276                                     TRIM( version_on_file ), '"',             &
277                                     '&version on program = "',                &
278                                     TRIM( binary_version_global ), '"'
279          CALL message( 'rrd_global', 'PA0296', 1, 2, 0, 6, 0 )
280       ENDIF
281
282!
283!--    Read number of PEs and horizontal index bounds of all PEs used in the
284!--    previous run
285       READ ( 13 )  length
286       READ ( 13 )  restart_string(1:length)
287
288       IF ( TRIM( restart_string(1:length) ) /= 'numprocs' )  THEN
289          WRITE( message_string, * ) 'numprocs not found in data from prior ', &
290                                     'run on PE ', myid
291          CALL message( 'rrd_global', 'PA0297', 1, 2, 0, 6, 0 )
292       ENDIF
293       READ ( 13 )  numprocs_previous_run
294
295       IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
296          ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
297       ENDIF
298
299       READ ( 13 )  length
300       READ ( 13 )  restart_string(1:length)
301
302       IF ( restart_string(1:length) /= 'hor_index_bounds' )  THEN
303          WRITE( message_string, * ) 'hor_index_bounds not found in data ',    &
304                                     'from prior run on PE ', myid
305          CALL message( 'rrd_global', 'PA0298', 1, 2, 0, 6, 0 )
306       ENDIF
307       READ ( 13 )  hor_index_bounds_previous_run
308
309!
310!--    Read vertical number of gridpoints and number of different areas used
311!--    for computing statistics. Allocate arrays depending on these values,
312!--    which are needed for the following read instructions.
313       READ ( 13 )  length
314       READ ( 13 )  restart_string(1:length)
315
316       IF ( restart_string(1:length) /= 'nz' )  THEN
317          WRITE( message_string, * ) 'nz not found in data from prior run ',   &
318                                     'on PE ', myid
319          CALL message( 'rrd_global', 'PA0299', 1, 2, 0, 6, 0 )
320       ENDIF
321       READ ( 13 )  nz
322
323       READ ( 13 )  length
324       READ ( 13 )  restart_string(1:length)
325
326       IF ( restart_string(1:length) /= 'max_pr_user' )  THEN
327          WRITE( message_string, * ) 'max_pr_user not found in data from ',    &
328                                     'prior run on PE ', myid
329          CALL message( 'rrd_global', 'PA0300', 1, 2, 0, 6, 0 )
330       ENDIF
331       READ ( 13 )  max_pr_user    ! This value is checked against the number of
332                                   ! user profiles given for the current run
333                                   ! in routine user_parin (it has to match)
334
335       READ ( 13 )  length
336       READ ( 13 )  restart_string(1:length)
337
338       IF ( restart_string(1:length) /= 'statistic_regions' )  THEN
339          WRITE( message_string, * ) 'statistic_regions not found in data ',   &
340                                     'from prior run on PE ', myid
341          CALL message( 'rrd_global', 'PA0301', 1, 2, 0, 6, 0 )
342       ENDIF
343       READ ( 13 )  statistic_regions
344
345!
346!--    The following global arrays (better to say, they have the same size and values on each
347!--    subdomain) are by default allocated in routine parin, but not in case of restarts!
348       IF ( .NOT. ALLOCATED( ug ) )  THEN
349          ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),                                        &
350                    v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),                               &
351                    ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),                            &
352                    hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions),  &
353                    hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions) )
354       ENDIF
355
356!
357!--    Now read all control parameters:
358!--    Caution: When the following read instructions have been changed, the
359!--    -------  version number stored in the variable binary_version_global has
360!--             to be increased. The same changes must also be done in
361!--             wrd_write_global.
362       READ ( 13 )  length
363       READ ( 13 )  restart_string(1:length)
364
365       DO WHILE ( restart_string(1:length) /= 'binary_version_local' )
366
367          found = .FALSE.
368
369          SELECT CASE ( restart_string(1:length) )
370
371             CASE ( 'advected_distance_x' )
372                READ ( 13 )  advected_distance_x
373             CASE ( 'advected_distance_y' )
374                READ ( 13 )  advected_distance_y
375             CASE ( 'alpha_surface' )
376                READ ( 13 )  alpha_surface
377             CASE ( 'average_count_pr' )
378                READ ( 13 )  average_count_pr
379             CASE ( 'average_count_sp' )
380                READ ( 13 )  average_count_sp
381             CASE ( 'average_count_3d' )
382                READ ( 13 )  average_count_3d
383             CASE ( 'bc_e_b' )
384                READ ( 13 )  bc_e_b
385             CASE ( 'bc_lr' )
386                READ ( 13 )  bc_lr
387             CASE ( 'bc_ns' )
388                READ ( 13 )  bc_ns
389             CASE ( 'bc_p_b' )
390                READ ( 13 )  bc_p_b
391             CASE ( 'bc_p_t' )
392                READ ( 13 )  bc_p_t
393             CASE ( 'bc_pt_b' )
394                READ ( 13 )  bc_pt_b
395             CASE ( 'bc_pt_t' )
396                READ ( 13 )  bc_pt_t
397             CASE ( 'bc_pt_t_val' )
398                READ ( 13 )  bc_pt_t_val
399             CASE ( 'bc_q_b' )
400                READ ( 13 )  bc_q_b
401             CASE ( 'bc_q_t' )
402                READ ( 13 )  bc_q_t
403             CASE ( 'bc_q_t_val' )
404                READ ( 13 )  bc_q_t_val
405             CASE ( 'bc_s_b' )
406                READ ( 13 )  bc_s_b
407             CASE ( 'bc_s_t' )
408                READ ( 13 )  bc_s_t
409             CASE ( 'bc_uv_b' )
410                READ ( 13 )  bc_uv_b
411             CASE ( 'bc_uv_t' )
412                READ ( 13 )  bc_uv_t
413             CASE ( 'building_height' )
414                READ ( 13 )  building_height
415             CASE ( 'building_length_x' )
416                READ ( 13 )  building_length_x
417             CASE ( 'building_length_y' )
418                READ ( 13 )  building_length_y
419             CASE ( 'building_wall_left' )
420                READ ( 13 )  building_wall_left
421             CASE ( 'building_wall_south' )
422                READ ( 13 )  building_wall_south
423             CASE ( 'call_psolver_at_all_substeps' )
424                READ ( 13 )  call_psolver_at_all_substeps
425             CASE ( 'canyon_height' )
426                READ ( 13 )  canyon_height
427             CASE ( 'canyon_wall_left' )
428                READ ( 13 )  canyon_wall_left
429             CASE ( 'canyon_wall_south' )
430                READ ( 13 )  canyon_wall_south
431             CASE ( 'canyon_width_x' )
432                READ ( 13 )  canyon_width_x
433             CASE ( 'canyon_width_y' )
434                READ ( 13 )  canyon_width_y
435             CASE ( 'cfl_factor' )
436                READ ( 13 )  cfl_factor
437             CASE ( 'cloud_droplets' )
438                READ ( 13 )  cloud_droplets
439             CASE ( 'collective_wait' )
440                READ ( 13 )  collective_wait
441             CASE ( 'conserve_volume_flow' )
442                READ ( 13 )  conserve_volume_flow
443             CASE ( 'conserve_volume_flow_mode' )
444                READ ( 13 )  conserve_volume_flow_mode
445             CASE ( 'constant_flux_layer' )
446                READ ( 13 )  constant_flux_layer
447             CASE ( 'coupling_start_time' )
448                READ ( 13 )  coupling_start_time
449             CASE ( 'current_timestep_number' )
450                READ ( 13 )  current_timestep_number
451             CASE ( 'cycle_mg' )
452                READ ( 13 )  cycle_mg
453             CASE ( 'damp_level_1d' )
454                READ ( 13 )  damp_level_1d
455             CASE ( 'origin_date_time' )
456                READ ( 13 )  origin_date_time
457             CASE ( 'dissipation_1d' )
458                READ ( 13 )  dissipation_1d
459             CASE ( 'do2d_xy_time_count' )
460                READ ( 13 )  do2d_xy_time_count
461             CASE ( 'do2d_xz_time_count' )
462                READ ( 13 )  do2d_xz_time_count
463             CASE ( 'do2d_yz_time_count' )
464                READ ( 13 )  do2d_yz_time_count
465             CASE ( 'do3d_time_count' )
466                READ ( 13 )  do3d_time_count
467             CASE ( 'dp_external' )
468                READ ( 13 )  dp_external
469             CASE ( 'dp_level_b' )
470                READ ( 13 )  dp_level_b
471             CASE ( 'dp_smooth' )
472                READ ( 13 )  dp_smooth
473             CASE ( 'dpdxy' )
474                READ ( 13 )  dpdxy
475             CASE ( 'dt_3d' )
476                READ ( 13 )  dt_3d
477             CASE ( 'dt_pr_1d' )
478                READ ( 13 )  dt_pr_1d
479             CASE ( 'dt_run_control_1d' )
480                READ ( 13 )  dt_run_control_1d
481             CASE ( 'dx' )
482                READ ( 13 )  dx
483             CASE ( 'dy' )
484                READ ( 13 )  dy
485             CASE ( 'dz' )
486                READ ( 13 )  dz
487             CASE ( 'dz_max' )
488                READ ( 13 )  dz_max
489             CASE ( 'dz_stretch_factor' )
490                READ ( 13 )  dz_stretch_factor
491             CASE ( 'dz_stretch_factor_array' )
492                READ ( 13 )  dz_stretch_factor_array
493             CASE ( 'dz_stretch_level' )
494                READ ( 13 )  dz_stretch_level
495             CASE ( 'dz_stretch_level_end' )
496                READ ( 13 )  dz_stretch_level_end
497             CASE ( 'dz_stretch_level_start' )
498                READ ( 13 )  dz_stretch_level_start
499             CASE ( 'e_min' )
500                READ ( 13 )  e_min
501             CASE ( 'end_time_1d' )
502                READ ( 13 )  end_time_1d
503             CASE ( 'fft_method' )
504                READ ( 13 )  fft_method
505             CASE ( 'first_call_lpm' )
506                READ ( 13 )  first_call_lpm
507             CASE ( 'galilei_transformation' )
508                READ ( 13 )  galilei_transformation
509             CASE ( 'hom' )
510                READ ( 13 )  hom
511             CASE ( 'hom_sum' )
512                READ ( 13 )  hom_sum
513             CASE ( 'humidity' )
514                READ ( 13 )  humidity
515             CASE ( 'inflow_damping_factor' )
516                IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
517                   ALLOCATE( inflow_damping_factor(0:nz+1) )
518                ENDIF
519                READ ( 13 )  inflow_damping_factor
520             CASE ( 'inflow_damping_height' )
521                READ ( 13 )  inflow_damping_height
522             CASE ( 'inflow_damping_width' )
523                READ ( 13 )  inflow_damping_width
524             CASE ( 'inflow_disturbance_begin' )
525                READ ( 13 )  inflow_disturbance_begin
526             CASE ( 'inflow_disturbance_end' )
527                READ ( 13 )  inflow_disturbance_end
528             CASE ( 'km_constant' )
529                READ ( 13 )  km_constant
530             CASE ( 'large_scale_forcing' )
531                READ ( 13 )  large_scale_forcing
532             CASE ( 'large_scale_subsidence' )
533                READ ( 13 )  large_scale_subsidence
534             CASE ( 'latitude' )
535                READ ( 13 )  latitude
536             CASE ( 'longitude' )
537                READ ( 13 )  longitude
538             CASE ( 'loop_optimization' )
539                READ ( 13 )  loop_optimization
540             CASE ( 'masking_method' )
541                READ ( 13 )  masking_method
542             CASE ( 'mean_inflow_profiles' )
543                IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
544                   ALLOCATE( mean_inflow_profiles(0:nz+1,1:num_mean_inflow_profiles) )
545                ENDIF
546                READ ( 13 )  mean_inflow_profiles
547             CASE ( 'mg_cycles' )
548                READ ( 13 )  mg_cycles
549             CASE ( 'mg_switch_to_pe0_level' )
550                READ ( 13 )  mg_switch_to_pe0_level
551             CASE ( 'mixing_length_1d' )
552                READ ( 13 )  mixing_length_1d
553             CASE ( 'momentum_advec' )
554                READ ( 13 )  momentum_advec
555             CASE ( 'netcdf_precision' )
556                READ ( 13 )  netcdf_precision
557             CASE ( 'neutral' )
558                READ ( 13 )  neutral
559             CASE ( 'ngsrb' )
560                READ ( 13 )  ngsrb
561             CASE ( 'nsor' )
562                READ ( 13 )  nsor
563             CASE ( 'nsor_ini' )
564                READ ( 13 )  nsor_ini
565             CASE ( 'nudging' )
566                READ ( 13 )  nudging
567             CASE ( 'num_leg' )
568                READ ( 13 )  num_leg
569             CASE ( 'nx' )
570                READ ( 13 )  nx
571                nx_on_file = nx
572             CASE ( 'ny' )
573                READ ( 13 )  ny
574                ny_on_file = ny
575             CASE ( 'ocean_mode' )
576                READ ( 13 )  ocean_mode
577             CASE ( 'omega' )
578                READ ( 13 )  omega
579             CASE ( 'omega_sor' )
580                READ ( 13 )  omega_sor
581             CASE ( 'output_for_t0' )
582                READ (13)    output_for_t0
583             CASE ( 'passive_scalar' )
584                READ ( 13 )  passive_scalar
585             CASE ( 'prandtl_number' )
586                READ ( 13 )  prandtl_number
587             CASE ( 'psolver' )
588                READ ( 13 )  psolver
589             CASE ( 'pt_damping_factor' )
590                READ ( 13 )  pt_damping_factor
591             CASE ( 'pt_damping_width' )
592                READ ( 13 )  pt_damping_width
593             CASE ( 'pt_init' )
594                READ ( 13 )  pt_init
595             CASE ( 'pt_reference' )
596                READ ( 13 )  pt_reference
597             CASE ( 'pt_surface' )
598                READ ( 13 )  pt_surface
599             CASE ( 'pt_surface_initial_change' )
600                READ ( 13 )  pt_surface_initial_change
601             CASE ( 'pt_vertical_gradient' )
602                READ ( 13 )  pt_vertical_gradient
603             CASE ( 'pt_vertical_gradient_level' )
604                READ ( 13 )  pt_vertical_gradient_level
605             CASE ( 'pt_vertical_gradient_level_ind' )
606                READ ( 13 )  pt_vertical_gradient_level_ind
607             CASE ( 'q_init' )
608                READ ( 13 )  q_init
609             CASE ( 'q_surface' )
610                READ ( 13 )  q_surface
611             CASE ( 'q_surface_initial_change' )
612                READ ( 13 )  q_surface_initial_change
613             CASE ( 'q_vertical_gradient' )
614                READ ( 13 )  q_vertical_gradient
615             CASE ( 'q_vertical_gradient_level' )
616                READ ( 13 )  q_vertical_gradient_level
617             CASE ( 'q_vertical_gradient_level_ind' )
618                READ ( 13 )  q_vertical_gradient_level_ind
619             CASE ( 'random_generator' )
620                READ ( 13 )  random_generator
621             CASE ( 'random_heatflux' )
622                READ ( 13 )  random_heatflux
623             CASE ( 'rans_mode' )
624                READ ( 13 )  rans_mode
625             CASE ( 'rayleigh_damping_factor' )
626                READ ( 13 )  rayleigh_damping_factor
627             CASE ( 'rayleigh_damping_height' )
628                READ ( 13 )  rayleigh_damping_height
629             CASE ( 'recycling_width' )
630                READ ( 13 )  recycling_width
631             CASE ( 'ref_state' )
632                READ ( 13 )  ref_state
633             CASE ( 'reference_state' )
634                READ ( 13 )  reference_state
635             CASE ( 'residual_limit' )
636                READ ( 13 )  residual_limit
637             CASE ( 'roughness_length' )
638                READ ( 13 )  roughness_length
639             CASE ( 'run_coupled' )
640                READ ( 13 )  run_coupled
641             CASE ( 'runnr' )
642                READ ( 13 )  runnr
643             CASE ( 's_init' )
644                READ ( 13 )  s_init
645             CASE ( 's_surface' )
646                READ ( 13 )  s_surface
647             CASE ( 's_surface_initial_change' )
648                READ ( 13 )  s_surface_initial_change
649             CASE ( 's_vertical_gradient' )
650                READ ( 13 )  s_vertical_gradient
651             CASE ( 's_vertical_gradient_level' )
652                READ ( 13 )  s_vertical_gradient_level
653             CASE ( 's_vertical_gradient_level_ind' )
654                READ ( 13 )  s_vertical_gradient_level_ind
655             CASE ( 'scalar_advec' )
656                READ ( 13 )  scalar_advec
657             CASE ( 'simulated_time' )
658                READ ( 13 )  simulated_time
659             CASE ( 'spectrum_x' )
660                IF ( .NOT. ALLOCATED( spectrum_x ) )  THEN
661                   ALLOCATE( spectrum_x( 1:nx/2, 1:100, 1:10 ) )
662                ENDIF
663                READ ( 13 )  spectrum_x
664             CASE ( 'spectrum_y' )
665                IF ( .NOT. ALLOCATED( spectrum_y ) )  THEN
666                   ALLOCATE( spectrum_y( 1:ny/2, 1:100, 1:10 ) )
667                ENDIF
668                READ ( 13 )  spectrum_y
669             CASE ( 'spinup_time' )
670                READ ( 13 )  spinup_time
671             CASE ( 'subs_vertical_gradient' )
672                READ ( 13 )  subs_vertical_gradient
673             CASE ( 'subs_vertical_gradient_level' )
674                READ ( 13 )  subs_vertical_gradient_level
675             CASE ( 'subs_vertical_gradient_level_i' )
676                READ ( 13 )  subs_vertical_gradient_level_i
677             CASE ( 'surface_heatflux' )
678                READ ( 13 )  surface_heatflux
679             CASE ( 'surface_pressure' )
680                READ ( 13 )  surface_pressure
681             CASE ( 'surface_scalarflux' )
682                READ ( 13 )  surface_scalarflux
683             CASE ( 'surface_waterflux' )
684                READ ( 13 )  surface_waterflux
685             CASE ( 'time_coupling' )
686                READ ( 13 )  time_coupling
687             CASE ( 'time_disturb' )
688                READ ( 13 )  time_disturb
689             CASE ( 'time_do2d_xy' )
690                READ ( 13 )  time_do2d_xy
691             CASE ( 'time_do2d_xz' )
692                READ ( 13 )  time_do2d_xz
693             CASE ( 'time_do2d_yz' )
694                READ ( 13 )  time_do2d_yz
695             CASE ( 'time_do3d' )
696                READ ( 13 )  time_do3d
697             CASE ( 'time_do_av' )
698                READ ( 13 )  time_do_av
699             CASE ( 'time_do_sla' )
700                READ ( 13 )  time_do_sla
701             CASE ( 'time_domask' )
702                READ ( 13 )  time_domask
703             CASE ( 'time_dopr' )
704                READ ( 13 )  time_dopr
705             CASE ( 'time_dopr_av' )
706                READ ( 13 )  time_dopr_av
707             CASE ( 'time_dopr_listing' )
708                READ ( 13 )  time_dopr_listing
709             CASE ( 'time_dopts' )
710                READ ( 13 )  time_dopts
711             CASE ( 'time_dosp' )
712                READ ( 13 )  time_dosp
713             CASE ( 'time_dots' )
714                READ ( 13 )  time_dots
715             CASE ( 'time_radiation' )
716                READ ( 13 )  time_radiation
717             CASE ( 'time_restart' )
718                READ ( 13 )  time_restart
719             CASE ( 'time_run_control' )
720                READ ( 13 )  time_run_control
721             CASE ( 'time_since_reference_point' )
722                READ ( 13 )  time_since_reference_point
723             CASE ( 'time_virtual_measurement' )
724                READ ( 13 )  time_virtual_measurement
725             CASE ( 'timestep_scheme' )
726                READ ( 13 )  timestep_scheme
727             CASE ( 'top_heatflux' )
728                READ ( 13 )  top_heatflux
729             CASE ( 'top_momentumflux_u' )
730                READ ( 13 )  top_momentumflux_u
731             CASE ( 'top_momentumflux_v' )
732                READ ( 13 )  top_momentumflux_v
733             CASE ( 'top_scalarflux' )
734                READ ( 13 )  top_scalarflux
735             CASE ( 'topography' )
736                READ ( 13 )  topography
737             CASE ( 'topography_grid_convention' )
738                READ ( 13 )  topography_grid_convention
739             CASE ( 'tsc' )
740                READ ( 13 )  tsc
741             CASE ( 'tunnel_height' )
742                READ ( 13 )  tunnel_height
743             CASE ( 'tunnel_length' )
744                READ ( 13 )  tunnel_length
745             CASE ( 'tunnel_wall_depth' )
746                READ ( 13 )  tunnel_wall_depth
747             CASE ( 'tunnel_width_x' )
748                READ ( 13 )  tunnel_width_x
749             CASE ( 'tunnel_width_y' )
750                READ ( 13 )  tunnel_width_y
751             CASE ( 'turbulence_closure' )
752                READ ( 13 )  turbulence_closure
753             CASE ( 'turbulent_inflow' )
754                READ ( 13 )  turbulent_inflow
755             CASE ( 'u_bulk' )
756                READ ( 13 )  u_bulk
757             CASE ( 'u_init' )
758                READ ( 13 )  u_init
759             CASE ( 'u_max' )
760                READ ( 13 )  u_max
761             CASE ( 'u_max_ijk' )
762                READ ( 13 )  u_max_ijk
763             CASE ( 'ug' )
764                READ ( 13 )  ug
765             CASE ( 'ug_surface' )
766                READ ( 13 )  ug_surface
767             CASE ( 'ug_vertical_gradient' )
768                READ ( 13 )  ug_vertical_gradient
769             CASE ( 'ug_vertical_gradient_level' )
770                READ ( 13 )  ug_vertical_gradient_level
771             CASE ( 'ug_vertical_gradient_level_ind' )
772                READ ( 13 )  ug_vertical_gradient_level_ind
773             CASE ( 'use_surface_fluxes' )
774                READ ( 13 )  use_surface_fluxes
775             CASE ( 'use_top_fluxes' )
776                READ ( 13 )  use_top_fluxes
777             CASE ( 'use_ug_for_galilei_tr' )
778                READ ( 13 )  use_ug_for_galilei_tr
779             CASE ( 'use_upstream_for_tke' )
780                READ ( 13 )  use_upstream_for_tke
781             CASE ( 'v_bulk' )
782                READ ( 13 )  v_bulk
783             CASE ( 'v_init' )
784                READ ( 13 )  v_init
785             CASE ( 'v_max' )
786                READ ( 13 )  v_max
787             CASE ( 'v_max_ijk' )
788                READ ( 13 )  v_max_ijk
789             CASE ( 'vg' )
790                READ ( 13 )  vg
791             CASE ( 'vg_surface' )
792                READ ( 13 )  vg_surface
793             CASE ( 'vg_vertical_gradient' )
794                READ ( 13 )  vg_vertical_gradient
795             CASE ( 'vg_vertical_gradient_level' )
796                READ ( 13 )  vg_vertical_gradient_level
797             CASE ( 'vg_vertical_gradient_level_ind' )
798                READ ( 13 )  vg_vertical_gradient_level_ind
799             CASE ( 'virtual_flight' )
800                READ ( 13 )  virtual_flight
801             CASE ( 'volume_flow_area' )
802                READ ( 13 )  volume_flow_area
803             CASE ( 'volume_flow_initial' )
804                READ ( 13 )  volume_flow_initial
805             CASE ( 'w_max' )
806                READ ( 13 )  w_max
807             CASE ( 'w_max_ijk' )
808                READ ( 13 )  w_max_ijk
809             CASE ( 'wall_adjustment' )
810                READ ( 13 )  wall_adjustment
811             CASE ( 'wall_heatflux' )
812                READ ( 13 )  wall_heatflux
813             CASE ( 'wall_humidityflux' )
814                READ ( 13 )  wall_humidityflux
815             CASE ( 'wall_scalarflux' )
816                READ ( 13 )  wall_scalarflux
817             CASE ( 'y_shift' )
818                READ ( 13 )  y_shift
819             CASE ( 'z0h_factor' )
820                READ ( 13 )  z0h_factor
821             CASE ( 'zeta_max' )
822                READ ( 13 )  zeta_max
823             CASE ( 'zeta_min' )
824                READ ( 13 )  zeta_min
825             CASE ( 'z_i' )
826                READ ( 13 )  z_i
827
828             CASE DEFAULT
829!
830!--             Read global variables from of other modules
831                CALL module_interface_rrd_global( found )
832
833                IF ( .NOT. found )  THEN
834                   WRITE( message_string, * ) 'unknown variable named "',      &
835                                           restart_string(1:length),           &
836                                          '" found in global data from ',      &
837                                          'prior run on PE ', myid
838                CALL message( 'rrd_global', 'PA0302', 1, 2, 0, 6, 0 )
839
840                ENDIF
841
842          END SELECT
843!
844!--       Read next string
845          READ ( 13 )  length
846          READ ( 13 )  restart_string(1:length)
847
848       ENDDO  ! End of loop for reading the restart string
849
850       CALL close_file( 13 )
851
852    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
853!
854!--    Read global restart data using MPI-IO
855!--    ATTENTION: Arrays need to be read with routine rrd_mpi_io_global_array!
856!--    Caution: When any of the following read instructions have been changed, the
857!--    -------  version number stored in the variable binary_version_global has
858!--             to be increased. The same changes must also be done in
859!--             wrd_write_global.
860!
861!--    Open the MPI-IO restart file.
862       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ),                              &
863                            open_for_global_io_only = .TRUE. )
864
865!
866!--    Make version number check first
867       CALL rrd_mpi_io( 'binary_version_global',  version_on_file )
868
869       binary_version_global = '5.0'
870       IF ( TRIM( version_on_file ) /= TRIM( binary_version_global ) )  THEN
871          WRITE( message_string, * ) 'version mismatch concerning binary_version_global:',         &
872                                     '&version on file    = "', TRIM( version_on_file ), '"',      &
873                                     '&version in program = "', TRIM( binary_version_global ), '"'
874          CALL message( 'rrd_global', 'PA0296', 1, 2, 0, 6, 0 )
875       ENDIF
876
877       CALL rrd_mpi_io( 'numprocs',  numprocs_previous_run )
878       CALL rrd_mpi_io( 'nz' , nz )
879       CALL rrd_mpi_io( 'max_pr_user',  max_pr_user )
880       CALL rrd_mpi_io( 'statistic_regions', statistic_regions )
881
882!
883!--    The following global arrays (better to say, they have the same size and values on each
884!--    subdomain) are by default allocated in routine parin, but not in case of restarts!
885       IF ( .NOT. ALLOCATED( ug ) )  THEN
886           ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),                                       &
887                     v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),                              &
888                     ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),                           &
889                     hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions), &
890                     hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0:statistic_regions) )
891       ENDIF
892
893       CALL rrd_mpi_io( 'advected_distance_x',  advected_distance_x )
894       CALL rrd_mpi_io( 'advected_distance_y', advected_distance_y )
895       CALL rrd_mpi_io( 'alpha_surface', alpha_surface )
896       CALL rrd_mpi_io( 'average_count_pr', average_count_pr )
897       CALL rrd_mpi_io( 'average_count_sp', average_count_sp )
898       CALL rrd_mpi_io( 'average_count_3d', average_count_3d )
899       CALL rrd_mpi_io( 'bc_e_b', bc_e_b )
900       CALL rrd_mpi_io( 'bc_lr', bc_lr )
901       CALL rrd_mpi_io( 'bc_ns', bc_ns )
902       CALL rrd_mpi_io( 'bc_p_b', bc_p_b )
903       CALL rrd_mpi_io( 'bc_p_t', bc_p_t )
904       CALL rrd_mpi_io( 'bc_pt_b', bc_pt_b )
905       CALL rrd_mpi_io( 'bc_pt_t', bc_pt_t )
906       CALL rrd_mpi_io( 'bc_pt_t_val', bc_pt_t_val )
907       CALL rrd_mpi_io( 'bc_q_b', bc_q_b )
908       CALL rrd_mpi_io( 'bc_q_t', bc_q_t )
909       CALL rrd_mpi_io( 'bc_q_t_val', bc_q_t_val )
910       CALL rrd_mpi_io( 'bc_s_b', bc_s_b )
911       CALL rrd_mpi_io( 'bc_s_t', bc_s_t )
912       CALL rrd_mpi_io( 'bc_uv_b', bc_uv_b )
913       CALL rrd_mpi_io( 'bc_uv_t', bc_uv_t )
914       CALL rrd_mpi_io( 'biometeorology', biometeorology )
915       CALL rrd_mpi_io( 'building_height', building_height )
916       CALL rrd_mpi_io( 'building_length_x', building_length_x )
917       CALL rrd_mpi_io( 'building_length_y', building_length_y )
918       CALL rrd_mpi_io( 'building_wall_left', building_wall_left )
919       CALL rrd_mpi_io( 'building_wall_south', building_wall_south )
920       CALL rrd_mpi_io( 'bulk_cloud_model', bulk_cloud_model )
921       CALL rrd_mpi_io( 'call_psolver_at_all_substeps', call_psolver_at_all_substeps )
922       CALL rrd_mpi_io( 'canyon_height', canyon_height )
923       CALL rrd_mpi_io( 'canyon_wall_left', canyon_wall_left )
924       CALL rrd_mpi_io( 'canyon_wall_south', canyon_wall_south )
925       CALL rrd_mpi_io( 'canyon_width_x',  canyon_width_x )
926       CALL rrd_mpi_io( 'canyon_width_y', canyon_width_y )
927       CALL rrd_mpi_io( 'cfl_factor', cfl_factor )
928       CALL rrd_mpi_io( 'cloud_droplets',  cloud_droplets )
929       CALL rrd_mpi_io( 'collective_wait', collective_wait )
930       CALL rrd_mpi_io( 'conserve_volume_flow', conserve_volume_flow )
931       CALL rrd_mpi_io( 'conserve_volume_flow_mode', conserve_volume_flow_mode )
932       CALL rrd_mpi_io( 'constant_flux_layer', constant_flux_layer )
933       CALL rrd_mpi_io( 'coupling_start_time', coupling_start_time )
934       CALL rrd_mpi_io( 'current_timestep_number', current_timestep_number )
935       CALL rrd_mpi_io( 'cycle_mg', cycle_mg )
936       CALL rrd_mpi_io( 'damp_level_1d', damp_level_1d )
937       CALL rrd_mpi_io( 'dissipation_1d', dissipation_1d )
938       CALL rrd_mpi_io_global_array( 'do2d_xy_time_count', do2d_xy_time_count )
939       CALL rrd_mpi_io_global_array( 'do2d_xz_time_count', do2d_xz_time_count )
940       CALL rrd_mpi_io_global_array( 'do2d_yz_time_count', do2d_yz_time_count )
941       CALL rrd_mpi_io_global_array( 'do3d_time_count', do3d_time_count )
942       CALL rrd_mpi_io( 'dp_external', dp_external )
943       CALL rrd_mpi_io( 'dp_level_b', dp_level_b )
944       CALL rrd_mpi_io( 'dp_smooth', dp_smooth )
945       CALL rrd_mpi_io_global_array( 'dpdxy', dpdxy )
946       CALL rrd_mpi_io( 'dt_3d', dt_3d )
947       CALL rrd_mpi_io( 'dt_pr_1d', dt_pr_1d )
948       CALL rrd_mpi_io( 'dt_run_control_1d', dt_run_control_1d )
949       CALL rrd_mpi_io( 'dx', dx )
950       CALL rrd_mpi_io( 'dy', dy )
951       CALL rrd_mpi_io_global_array( 'dz', dz )
952       CALL rrd_mpi_io( 'dz_max', dz_max )
953       CALL rrd_mpi_io( 'dz_stretch_factor', dz_stretch_factor )
954       CALL rrd_mpi_io_global_array( 'dz_stretch_factor_array', dz_stretch_factor_array )
955       CALL rrd_mpi_io( 'dz_stretch_level', dz_stretch_level )
956       CALL rrd_mpi_io_global_array( 'dz_stretch_level_end', dz_stretch_level_end )
957       CALL rrd_mpi_io_global_array( 'dz_stretch_level_start', dz_stretch_level_start )
958       CALL rrd_mpi_io( 'e_min', e_min )
959       CALL rrd_mpi_io( 'end_time_1d', end_time_1d )
960       CALL rrd_mpi_io( 'fft_method', fft_method )
961       CALL rrd_mpi_io( 'first_call_lpm', first_call_lpm )
962       CALL rrd_mpi_io( 'galilei_transformation', galilei_transformation )
963       CALL rrd_mpi_io( 'gust_module_enabled', gust_module_enabled )
964       CALL rrd_mpi_io_global_array( 'hom', hom )
965       CALL rrd_mpi_io_global_array( 'hom_sum', hom_sum )
966       CALL rrd_mpi_io( 'humidity', humidity )
967       CALL rd_mpi_io_check_array( 'inflow_damping_factor', found = array_found )
968       IF ( array_found )  THEN
969           IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
970               ALLOCATE( inflow_damping_factor(0:nz+1) )
971           ENDIF
972           CALL rrd_mpi_io_global_array( 'inflow_damping_factor', inflow_damping_factor )
973       ENDIF
974       CALL rrd_mpi_io( 'inflow_damping_height', inflow_damping_height )
975       CALL rrd_mpi_io( 'inflow_damping_width', inflow_damping_width )
976       CALL rrd_mpi_io( 'inflow_disturbance_begin', inflow_disturbance_begin )
977       CALL rrd_mpi_io( 'inflow_disturbance_end', inflow_disturbance_end )
978       CALL rrd_mpi_io( 'km_constant', km_constant )
979       CALL rrd_mpi_io( 'large_scale_forcing', large_scale_forcing )
980       CALL rrd_mpi_io( 'large_scale_subsidence', large_scale_subsidence )
981       CALL rrd_mpi_io( 'latitude', latitude )
982       CALL rrd_mpi_io( 'longitude', longitude )
983       CALL rrd_mpi_io( 'loop_optimization', loop_optimization )
984       CALL rrd_mpi_io( 'masking_method', masking_method )
985       CALL rd_mpi_io_check_array( 'mean_inflow_profiles', found = array_found )
986       IF ( array_found)  THEN
987          IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
988             ALLOCATE( mean_inflow_profiles(0:nz+1,7) )
989          ENDIF
990          CALL rrd_mpi_io_global_array( 'mean_inflow_profiles', mean_inflow_profiles )
991       ENDIF
992       CALL rrd_mpi_io( 'mg_cycles', mg_cycles )
993       CALL rrd_mpi_io( 'mg_switch_to_pe0_level', mg_switch_to_pe0_level )
994       CALL rrd_mpi_io( 'mixing_length_1d', mixing_length_1d )
995       CALL rrd_mpi_io( 'momentum_advec', momentum_advec )
996!
997!--    There is no module procedure for CHARACTER arrays
998       DO  i = 1, SIZE( netcdf_precision , 1 )
999          WRITE( tmp_name, '(A,I2.2)' )  'netcdf_precision_', i
1000          CALL rrd_mpi_io( TRIM( tmp_name ), netcdf_precision(i) )
1001       ENDDO
1002       CALL rrd_mpi_io( 'neutral', neutral )
1003       CALL rrd_mpi_io( 'ngsrb', ngsrb )
1004       CALL rrd_mpi_io( 'nsor', nsor )
1005       CALL rrd_mpi_io( 'nsor_ini', nsor_ini )
1006       CALL rrd_mpi_io( 'nudging', nudging )
1007       CALL rrd_mpi_io( 'num_leg', num_leg )
1008       CALL rrd_mpi_io( 'nx', nx )
1009       nx_on_file = nx
1010       CALL rrd_mpi_io( 'ny', ny )
1011       ny_on_file = ny
1012       CALL rrd_mpi_io( 'ocean_mode', ocean_mode )
1013       CALL rrd_mpi_io( 'omega', omega )
1014       CALL rrd_mpi_io( 'omega_sor', omega_sor )
1015       CALL rrd_mpi_io( 'origin_date_time', origin_date_time )
1016       CALL rrd_mpi_io( 'output_for_t0', output_for_t0 )
1017       CALL rrd_mpi_io( 'particle_advection', particle_advection )
1018       CALL rrd_mpi_io( 'passive_scalar', passive_scalar )
1019       CALL rrd_mpi_io( 'prandtl_number', prandtl_number )
1020       CALL rrd_mpi_io( 'psolver', psolver )
1021       CALL rrd_mpi_io( 'pt_damping_factor', pt_damping_factor )
1022       CALL rrd_mpi_io( 'pt_damping_width', pt_damping_width )
1023       CALL rrd_mpi_io_global_array( 'pt_init', pt_init )
1024       CALL rrd_mpi_io( 'pt_reference', pt_reference )
1025       CALL rrd_mpi_io( 'pt_surface', pt_surface )
1026       CALL rrd_mpi_io( 'pt_surface_initial_change', pt_surface_initial_change )
1027       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient', pt_vertical_gradient )
1028       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient_level', pt_vertical_gradient_level )
1029       CALL rrd_mpi_io_global_array( 'pt_vertical_gradient_level_ind', pt_vertical_gradient_level_ind )
1030       CALL rrd_mpi_io_global_array( 'q_init', q_init )
1031       CALL rrd_mpi_io( 'q_surface', q_surface )
1032       CALL rrd_mpi_io( 'q_surface_initial_change', q_surface_initial_change )
1033       CALL rrd_mpi_io_global_array( 'q_vertical_gradient', q_vertical_gradient )
1034       CALL rrd_mpi_io_global_array( 'q_vertical_gradient_level', q_vertical_gradient_level )
1035       CALL rrd_mpi_io_global_array( 'q_vertical_gradient_level_ind', q_vertical_gradient_level_ind )
1036       CALL rrd_mpi_io( 'random_generator', random_generator )
1037       CALL rrd_mpi_io( 'random_heatflux', random_heatflux )
1038       CALL rrd_mpi_io( 'rans_mode', rans_mode )
1039       CALL rrd_mpi_io( 'rayleigh_damping_factor', rayleigh_damping_factor )
1040       CALL rrd_mpi_io( 'rayleigh_damping_height', rayleigh_damping_height )
1041       CALL rrd_mpi_io( 'recycling_width', recycling_width )
1042       CALL rrd_mpi_io_global_array( 'ref_state', ref_state )
1043       CALL rrd_mpi_io( 'reference_state', reference_state )
1044       CALL rrd_mpi_io( 'residual_limit', residual_limit )
1045       CALL rrd_mpi_io( 'roughness_length', roughness_length )
1046       CALL rrd_mpi_io( 'run_coupled', run_coupled )
1047       CALL rrd_mpi_io( 'runnr', runnr )
1048       CALL rrd_mpi_io_global_array( 's_init', s_init )
1049       CALL rrd_mpi_io( 's_surface', s_surface )
1050       CALL rrd_mpi_io( 's_surface_initial_change', s_surface_initial_change )
1051       CALL rrd_mpi_io_global_array( 's_vertical_gradient', s_vertical_gradient )
1052       CALL rrd_mpi_io_global_array( 's_vertical_gradient_level', s_vertical_gradient_level )
1053       CALL rrd_mpi_io_global_array( 's_vertical_gradient_level_ind', s_vertical_gradient_level_ind )
1054       CALL rrd_mpi_io( 'scalar_advec', scalar_advec )
1055       CALL rrd_mpi_io( 'simulated_time', simulated_time )
1056       CALL rd_mpi_io_check_array( 'spectrum_x', found = array_found )
1057       IF (array_found )  THEN
1058           IF ( .NOT. ALLOCATED( spectrum_x ) )  THEN
1059              ALLOCATE( spectrum_x( 1:nx/2, 1:100, 1:10 ) )
1060           ENDIF
1061           CALL rrd_mpi_io( 'spectrum_y', spectrum_y )
1062       ENDIF
1063       CALL rd_mpi_io_check_array( 'spectrum_y', found = array_found )
1064       IF ( array_found )  THEN
1065           IF ( .NOT. ALLOCATED( spectrum_y ) )  THEN
1066              ALLOCATE( spectrum_y( 1:ny/2, 1:100, 1:10 ) )
1067           ENDIF
1068           CALL rrd_mpi_io( 'spectrum_y', spectrum_y )
1069       ENDIF
1070       CALL rrd_mpi_io( 'spinup_time ', spinup_time )
1071       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient', subs_vertical_gradient )
1072       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient_level', subs_vertical_gradient_level )
1073       CALL rrd_mpi_io_global_array( 'subs_vertical_gradient_level_i', subs_vertical_gradient_level_i )
1074       CALL rrd_mpi_io( 'surface_heatflux', surface_heatflux )
1075       CALL rrd_mpi_io( 'surface_pressure', surface_pressure )
1076       CALL rrd_mpi_io( 'surface_output', surface_output )
1077       CALL rrd_mpi_io( 'surface_scalarflux', surface_scalarflux )
1078       CALL rrd_mpi_io( 'surface_waterflux', surface_waterflux )
1079       CALL rrd_mpi_io( 'syn_turb_gen', syn_turb_gen )
1080       CALL rrd_mpi_io( 'time_coupling', time_coupling )
1081       CALL rrd_mpi_io( 'time_disturb', time_disturb )
1082       CALL rrd_mpi_io( 'time_do2d_xy', time_do2d_xy )
1083       CALL rrd_mpi_io( 'time_do2d_xz', time_do2d_xz )
1084       CALL rrd_mpi_io( 'time_do2d_yz', time_do2d_yz )
1085       CALL rrd_mpi_io( 'time_do3d', time_do3d )
1086       CALL rrd_mpi_io( 'time_do_av', time_do_av )
1087       CALL rrd_mpi_io( 'time_do_sla', time_do_sla )
1088       CALL rrd_mpi_io_global_array( 'time_domask', time_domask )
1089       CALL rrd_mpi_io( 'time_dopr', time_dopr )
1090       CALL rrd_mpi_io( 'time_dopr_av', time_dopr_av )
1091       CALL rrd_mpi_io( 'time_dopr_listing', time_dopr_listing )
1092       CALL rrd_mpi_io( 'time_dopts', time_dopts )
1093       CALL rrd_mpi_io( 'time_dosp', time_dosp )
1094       CALL rrd_mpi_io( 'time_dots', time_dots )
1095       CALL rrd_mpi_io( 'time_radiation', time_radiation )
1096       CALL rrd_mpi_io( 'time_restart', time_restart )
1097       CALL rrd_mpi_io( 'time_run_control', time_run_control )
1098       CALL rrd_mpi_io( 'time_since_reference_point', time_since_reference_point )
1099       CALL rrd_mpi_io( 'time_virtual_measurement', time_virtual_measurement )
1100       CALL rrd_mpi_io( 'timestep_scheme', timestep_scheme )
1101       CALL rrd_mpi_io( 'top_heatflux', top_heatflux )
1102       CALL rrd_mpi_io( 'top_momentumflux_u', top_momentumflux_u )
1103       CALL rrd_mpi_io( 'top_momentumflux_v', top_momentumflux_v )
1104       CALL rrd_mpi_io( 'top_scalarflux', top_scalarflux )
1105       CALL rrd_mpi_io( 'topography', topography )
1106       CALL rrd_mpi_io( 'topography_grid_convention', topography_grid_convention )
1107       CALL rrd_mpi_io_global_array( 'tsc', tsc )
1108       CALL rrd_mpi_io( 'tunnel_height', tunnel_height )
1109       CALL rrd_mpi_io( 'tunnel_length', tunnel_length )
1110       CALL rrd_mpi_io( 'tunnel_wall_depth', tunnel_wall_depth )
1111       CALL rrd_mpi_io( 'tunnel_width_x', tunnel_width_x )
1112       CALL rrd_mpi_io( 'tunnel_width_y', tunnel_width_y )
1113       CALL rrd_mpi_io( 'turbulence_closure', turbulence_closure )
1114       CALL rrd_mpi_io( 'turbulent_inflow', turbulent_inflow )
1115       CALL rrd_mpi_io( 'u_bulk', u_bulk )
1116       CALL rrd_mpi_io_global_array( 'u_init', u_init )
1117       CALL rrd_mpi_io( 'u_max', u_max )
1118       CALL rrd_mpi_io_global_array( 'u_max_ijk', u_max_ijk )
1119       CALL rrd_mpi_io_global_array( 'ug', ug )
1120       CALL rrd_mpi_io( 'ug_surface', ug_surface )
1121       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient', ug_vertical_gradient )
1122       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient_level', ug_vertical_gradient_level )
1123       CALL rrd_mpi_io_global_array( 'ug_vertical_gradient_level_ind', ug_vertical_gradient_level_ind )
1124       CALL rrd_mpi_io( 'use_surface_fluxes', use_surface_fluxes )
1125       CALL rrd_mpi_io( 'use_top_fluxes', use_top_fluxes )
1126       CALL rrd_mpi_io( 'use_ug_for_galilei_tr', use_ug_for_galilei_tr )
1127       CALL rrd_mpi_io( 'use_upstream_for_tke', use_upstream_for_tke )
1128       CALL rrd_mpi_io( 'user_module_enabled', user_module_enabled )
1129       CALL rrd_mpi_io( 'v_bulk', v_bulk )
1130       CALL rrd_mpi_io_global_array( 'v_init', v_init )
1131       CALL rrd_mpi_io( 'v_max', v_max )
1132       CALL rrd_mpi_io_global_array( 'v_max_ijk', v_max_ijk )
1133       CALL rrd_mpi_io_global_array( 'vg', vg )
1134       CALL rrd_mpi_io( 'vg_surface', vg_surface )
1135       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient', vg_vertical_gradient )
1136       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient_level', vg_vertical_gradient_level )
1137       CALL rrd_mpi_io_global_array( 'vg_vertical_gradient_level_ind', vg_vertical_gradient_level_ind )
1138       CALL rrd_mpi_io( 'virtual_flight', virtual_flight )
1139       CALL rrd_mpi_io_global_array( 'volume_flow_area', volume_flow_area )
1140       CALL rrd_mpi_io_global_array( 'volume_flow_initial', volume_flow_initial )
1141       CALL rrd_mpi_io( 'w_max', w_max )
1142       CALL rrd_mpi_io_global_array( 'w_max_ijk', w_max_ijk )
1143       CALL rrd_mpi_io( 'wall_adjustment', wall_adjustment )
1144       CALL rrd_mpi_io_global_array( 'wall_heatflux', wall_heatflux )
1145       CALL rrd_mpi_io_global_array( 'wall_humidityflux', wall_humidityflux )
1146       CALL rrd_mpi_io_global_array( 'wall_scalarflux', wall_scalarflux )
1147       CALL rrd_mpi_io( 'y_shift', y_shift )
1148       CALL rrd_mpi_io( 'z0h_factor', z0h_factor )
1149       CALL rrd_mpi_io( 'zeta_max', zeta_max )
1150       CALL rrd_mpi_io( 'zeta_min', zeta_min )
1151       CALL rrd_mpi_io_global_array( 'z_i', z_i )
1152
1153!
1154!--    Read global variables from of other modules
1155       CALL module_interface_rrd_global
1156
1157!
1158!--    Close restart file
1159       CALL rd_mpi_io_close
1160
1161    ENDIF
1162
1163    CALL location_message( 'read global restart data', 'finished' )
1164
1165 END SUBROUTINE rrd_global
1166
1167
1168
1169!------------------------------------------------------------------------------!
1170! Description:
1171! ------------
1172!> Skipping the global control variables from restart-file (binary format)
1173!> except some information needed when reading restart data from a previous
1174!> run which used a smaller total domain or/and a different domain decomposition
1175!> (initializing_actions  == 'cyclic_fill').
1176!------------------------------------------------------------------------------!
1177 SUBROUTINE rrd_read_parts_of_global
1178
1179
1180    CHARACTER (LEN=10) ::  version_on_file
1181    CHARACTER (LEN=20) ::  bc_lr_on_file
1182    CHARACTER (LEN=20) ::  bc_ns_on_file
1183    CHARACTER (LEN=20) ::  momentum_advec_check
1184    CHARACTER (LEN=20) ::  scalar_advec_check
1185    CHARACTER (LEN=1)  ::  cdum
1186
1187    INTEGER(iwp) ::  max_pr_user_on_file
1188    INTEGER(iwp) ::  nz_on_file
1189    INTEGER(iwp) ::  statistic_regions_on_file
1190    INTEGER(iwp) ::  tmp_mpru
1191    INTEGER(iwp) ::  tmp_sr
1192
1193    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
1194    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
1195
1196
1197    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
1198!
1199!--    Input in Fortran binary format
1200       CALL check_open( 13 )
1201
1202       READ ( 13 )  length
1203       READ ( 13 )  restart_string(1:length)
1204       READ ( 13 )  version_on_file
1205
1206!
1207!--    Read number of PEs and horizontal index bounds of all PEs used in previous run
1208       READ ( 13 )  length
1209       READ ( 13 )  restart_string(1:length)
1210
1211       IF ( restart_string(1:length) /= 'numprocs' )  THEN
1212          WRITE( message_string, * ) 'numprocs not found in data from prior ', &
1213                                     'run on PE ', myid
1214          CALL message( 'rrd_read_parts_of_global', 'PA0297', 1, 2, 0, 6, 0 )
1215       ENDIF
1216       READ ( 13 )  numprocs_previous_run
1217
1218       IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
1219          ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
1220       ENDIF
1221
1222       READ ( 13 )  length
1223       READ ( 13 )  restart_string(1:length)
1224
1225       IF ( restart_string(1:length) /= 'hor_index_bounds' )  THEN
1226          WRITE( message_string, * ) 'hor_index_bounds not found in data ',    &
1227                                     'from prior run on PE ', myid
1228          CALL message( 'rrd_read_parts_of_global', 'PA0298', 1, 2, 0, 6, 0 )
1229       ENDIF
1230       READ ( 13 )  hor_index_bounds_previous_run
1231
1232!
1233!--    Read vertical number of gridpoints and number of different areas used for computing
1234!--    statistics. Allocate arrays depending on these values, which are needed for the following
1235!--    read instructions.
1236       READ ( 13 )  length
1237       READ ( 13 )  restart_string(1:length)
1238
1239       IF ( restart_string(1:length) /= 'nz' )  THEN
1240          message_string = 'nz not found in restart data file'
1241          CALL message( 'rrd_read_parts_of_global', 'PA0303', 1, 2, 0, 6, 0 )
1242       ENDIF
1243       READ ( 13 )  nz_on_file
1244       IF ( nz_on_file /= nz )  THEN
1245          WRITE( message_string, * ) 'mismatch concerning number of ',         &
1246                                     'gridpoints along z:',                    &
1247                                     '&nz on file    = "', nz_on_file, '"',    &
1248                                     '&nz from run   = "', nz, '"'
1249          CALL message( 'rrd_read_parts_of_global', 'PA0304', 1, 2, 0, 6, 0 )
1250       ENDIF
1251
1252       READ ( 13 )  length
1253       READ ( 13 )  restart_string(1:length)
1254
1255       IF ( restart_string(1:length) /= 'max_pr_user' )  THEN
1256          message_string = 'max_pr_user not found in restart data file'
1257          CALL message( 'rrd_read_parts_of_global', 'PA0305', 1, 2, 0, 6, 0 )
1258       ENDIF
1259       READ ( 13 )  max_pr_user_on_file
1260       IF ( max_pr_user_on_file /= max_pr_user )  THEN
1261          WRITE( message_string, * ) 'number of user profiles on res',         &
1262                                     'tart data file differs from the ',       &
1263                                     'current run:&max_pr_user on file    = "',&
1264                                     max_pr_user_on_file, '"',                 &
1265                                     '&max_pr_user from run   = "',            &
1266                                     max_pr_user, '"'
1267          CALL message( 'rrd_read_parts_of_global', 'PA0306', 0, 0, 0, 6, 0 )
1268          tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
1269       ELSE
1270          tmp_mpru = max_pr_user
1271       ENDIF
1272
1273       READ ( 13 )  length
1274       READ ( 13 )  restart_string(1:length)
1275
1276       IF ( restart_string(1:length) /= 'statistic_regions' )  THEN
1277          message_string = 'statistic_regions not found in restart data file'
1278          CALL message( 'rrd_read_parts_of_global', 'PA0307', 1, 2, 0, 6, 0 )
1279       ENDIF
1280       READ ( 13 )  statistic_regions_on_file
1281       IF ( statistic_regions_on_file /= statistic_regions )  THEN
1282          WRITE( message_string, * ) 'statistic regions on restart data file ',&
1283                                     'differ from the current run:',           &
1284                                     '&statistic regions on file    = "',      &
1285                                     statistic_regions_on_file, '"',           &
1286                                     '&statistic regions from run   = "',      &
1287                                      statistic_regions, '"',                  &
1288                                     '&statistic data may be lost!'
1289          CALL message( 'rrd_read_parts_of_global', 'PA0308', 0, 1, 0, 6, 0 )
1290          tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
1291       ELSE
1292          tmp_sr = statistic_regions
1293       ENDIF
1294
1295!
1296!--    Now read and check some control parameters and skip the rest
1297       READ ( 13 )  length
1298       READ ( 13 )  restart_string(1:length)
1299
1300       DO  WHILE ( restart_string(1:length) /= 'binary_version_local' )
1301
1302          SELECT CASE ( restart_string(1:length) )
1303
1304             CASE ( 'average_count_pr' )
1305                READ ( 13 )  average_count_pr
1306                IF ( average_count_pr /= 0 )  THEN
1307                   WRITE( message_string, * ) 'inflow profiles not ',          &
1308                                  'temporally averaged. &Averaging will be ',  &
1309                                  'done now using', average_count_pr,          &
1310                                  ' samples.'
1311                   CALL message( 'rrd_read_parts_of_global', 'PA0309',         &
1312                                 0, 1, 0, 6, 0 )
1313                ENDIF
1314
1315             CASE ( 'bc_lr' )
1316                READ ( 13 )  bc_lr_on_file
1317                IF ( TRIM( bc_lr_on_file ) /= 'cyclic' )  THEN
1318                   message_string = 'bc_lr in the prerun was set /= "cyclic"'
1319                   CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
1320                ENDIF
1321
1322             CASE ( 'bc_ns' )
1323                READ ( 13 )  bc_ns_on_file
1324                IF ( TRIM( bc_ns_on_file ) /= 'cyclic' )  THEN
1325                   message_string = 'bc_ns in the prerun was set /= "cyclic"'
1326                   CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
1327                ENDIF
1328
1329             CASE ( 'hom' )
1330                ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file,    &
1331                          0:statistic_regions_on_file) )
1332                READ ( 13 )  hom_on_file
1333                hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) =                         &
1334                             hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
1335                DEALLOCATE( hom_on_file )
1336
1337             CASE ( 'hom_sum' )
1338                ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file,  &
1339                          0:statistic_regions_on_file) )
1340                READ ( 13 )  hom_sum_on_file
1341                hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) =                       &
1342                             hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
1343                DEALLOCATE( hom_sum_on_file )
1344
1345             CASE ( 'momentum_advec' )
1346                momentum_advec_check = momentum_advec
1347                READ ( 13 )  momentum_advec
1348                IF ( TRIM( momentum_advec_check ) /= TRIM( momentum_advec ) )  &
1349                THEN
1350                   WRITE( message_string, * ) 'momentum_advec of the restart ',&
1351                                  'run differs from momentum_advec of the ',   &
1352                                  'initial run.'
1353                   CALL message( 'rrd_read_parts_of_global', 'PA0100',         &
1354                                 1, 2, 0, 6, 0 )
1355                ENDIF
1356
1357             CASE ( 'nx' )
1358                READ ( 13 )  nx_on_file
1359
1360             CASE ( 'ny' )
1361                READ ( 13 )  ny_on_file
1362
1363             CASE ( 'ref_state' )
1364                READ ( 13 )  ref_state
1365
1366             CASE ( 'scalar_advec' )
1367                scalar_advec_check = scalar_advec
1368                READ ( 13 )  scalar_advec
1369                IF ( TRIM( scalar_advec_check ) /= TRIM( scalar_advec ) )      &
1370                THEN
1371                   WRITE( message_string, * ) 'scalar_advec of the restart ',  &
1372                                  'run differs from scalar_advec of the ',     &
1373                                  'initial run.'
1374                   CALL message( 'rrd_read_parts_of_global', 'PA0101',         &
1375                                 1, 2, 0, 6, 0 )
1376                ENDIF
1377
1378             CASE DEFAULT
1379
1380                READ ( 13 )  cdum
1381
1382          END SELECT
1383
1384          READ ( 13 )  length
1385          READ ( 13 )  restart_string(1:length)
1386
1387       ENDDO
1388
1389       CALL close_file( 13 )
1390
1391    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
1392!
1393!--    Open the MPI-IO restart file.
1394       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ),                              &
1395                            open_for_global_io_only = .TRUE. )
1396
1397!
1398!--    Read vertical number of gridpoints and number of different areas used for computing
1399!--    statistics. Allocate arrays depending on these values, which are required for the following
1400!--    read instructions.
1401       CALL rrd_mpi_io( 'nz', nz_on_file )
1402       IF ( nz_on_file /= nz )  THEN
1403          WRITE( message_string, * ) 'mismatch concerning number of gridpoints along z:',          &
1404                                     '&nz on file    = "', nz_on_file, '"',                        &
1405                                     '&nz from run   = "', nz, '"'
1406          CALL message( 'rrd_read_parts_of_global', 'PA0304', 1, 2, 0, 6, 0 )
1407       ENDIF
1408
1409       CALL rrd_mpi_io( 'max_pr_user', max_pr_user_on_file )
1410       IF ( max_pr_user_on_file /= max_pr_user )  THEN
1411          WRITE( message_string, * ) 'number of user profiles on restart data file differs from ', &
1412                                     'the current run:&max_pr_user on file    = "',                &
1413                                     max_pr_user_on_file, '" &max_pr_user from run   = "',         &
1414                                     max_pr_user, '"'
1415          CALL message( 'rrd_read_parts_of_global', 'PA0306', 0, 0, 0, 6, 0 )
1416          tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
1417       ELSE
1418          tmp_mpru = max_pr_user
1419       ENDIF
1420
1421       CALL rrd_mpi_io( 'statistic_regions', statistic_regions_on_file )
1422       IF ( statistic_regions_on_file /= statistic_regions )  THEN
1423          WRITE( message_string, * ) 'statistic regions on restart data file ',&
1424                                     'differ from the current run:',           &
1425                                     '&statistic regions on file    = "',      &
1426                                     statistic_regions_on_file, '"',           &
1427                                     '&statistic regions from run   = "',      &
1428                                      statistic_regions, '"',                  &
1429                                     '&statistic data may be lost!'
1430          CALL message( 'rrd_read_parts_of_global', 'PA0308', 0, 1, 0, 6, 0 )
1431          tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
1432       ELSE
1433          tmp_sr = statistic_regions
1434       ENDIF
1435
1436!
1437!--    Now read and check some control parameters and skip the rest.
1438       CALL rrd_mpi_io( 'average_count_pr', average_count_pr )
1439       IF ( average_count_pr /= 0 )  THEN
1440          WRITE( message_string, * ) 'inflow profiles not ',          &
1441                         'temporally averaged. &Averaging will be ',  &
1442                         'done now using', average_count_pr,          &
1443                         ' samples.'
1444          CALL message( 'rrd_read_parts_of_global', 'PA0309', 0, 1, 0, 6, 0 )
1445       ENDIF
1446
1447       ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file,0:statistic_regions_on_file) )
1448       CALL rrd_mpi_io_global_array( 'hom', hom_on_file )
1449       hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) = hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
1450       DEALLOCATE( hom_on_file )
1451
1452       ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file, 0:statistic_regions_on_file) )
1453       CALL rrd_mpi_io_global_array( 'hom_sum', hom_sum_on_file )
1454       hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) = hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
1455       DEALLOCATE( hom_sum_on_file )
1456
1457       momentum_advec_check = momentum_advec
1458       CALL rrd_mpi_io( 'momentum_advec', momentum_advec )
1459       IF ( TRIM( momentum_advec_check ) /= TRIM( momentum_advec ) )  THEN
1460          WRITE( message_string, * ) 'momentum_advec of the restart ',&
1461                                  'run differs from momentum_advec of the ',   &
1462                                  'initial run.'
1463          CALL message( 'rrd_read_parts_of_global', 'PA0100', 1, 2, 0, 6, 0 )
1464       ENDIF
1465
1466       CALL rrd_mpi_io( 'bc_lr', bc_lr_on_file )
1467       CALL rrd_mpi_io( 'bc_ns', bc_ns_on_file )
1468       IF ( TRIM( bc_lr_on_file ) /= 'cyclic'  .OR.  TRIM( bc_ns_on_file ) /= 'cyclic' )  THEN
1469          message_string = 'bc_lr and/or bc_ns in the prerun was set /= "cyclic"'
1470          CALL message( 'rrd_read_parts_of_global', 'PA0498', 1, 2, 0, 6, 0 )
1471       ENDIF
1472
1473       scalar_advec_check = scalar_advec
1474       CALL rrd_mpi_io( 'scalar_advec', scalar_advec )
1475       IF ( TRIM( scalar_advec_check ) /= TRIM( scalar_advec ) )  THEN
1476          WRITE( message_string, * ) 'scalar_advec of the restart ',  &
1477                                  'run differs from scalar_advec of the ',     &
1478                                  'initial run.'
1479          CALL message( 'rrd_read_parts_of_global', 'PA0101', 1, 2, 0, 6, 0 )
1480       ENDIF
1481
1482       CALL rrd_mpi_io( 'nx', nx_on_file )
1483       CALL rrd_mpi_io( 'ny', ny_on_file )
1484       CALL rrd_mpi_io_global_array( 'ref_state', ref_state )
1485
1486!
1487!--    Close restart file
1488       CALL rd_mpi_io_close
1489
1490    ENDIF
1491
1492!
1493!-- Calculate the temporal average of vertical profiles, if neccessary
1494    IF ( average_count_pr /= 0 )  THEN
1495       hom_sum = hom_sum / REAL( average_count_pr, KIND=wp )
1496    ENDIF
1497
1498 END SUBROUTINE rrd_read_parts_of_global
1499
1500
1501! Description:
1502! ------------
1503!> Reads processor (subdomain) specific data of variables and arrays from restart file
1504!> (binary format).
1505!------------------------------------------------------------------------------!
1506 SUBROUTINE rrd_local
1507
1508
1509    CHARACTER (LEN=7)  ::  myid_char_save
1510    CHARACTER (LEN=10) ::  binary_version_local
1511    CHARACTER (LEN=10) ::  version_on_file
1512    CHARACTER (LEN=20) ::  tmp_name               !< temporary variable
1513
1514    INTEGER(iwp) ::  files_to_be_opened  !<
1515    INTEGER(iwp) ::  i                   !<
1516    INTEGER(iwp) ::  j                   !<
1517    INTEGER(iwp) ::  k                   !<
1518    INTEGER(iwp) ::  myid_on_file        !<
1519    INTEGER(iwp) ::  numprocs_on_file    !<
1520    INTEGER(iwp) ::  nxlc                !<
1521    INTEGER(iwp) ::  nxlf                !<
1522    INTEGER(iwp) ::  nxlpr               !<
1523    INTEGER(iwp) ::  nxl_on_file         !<
1524    INTEGER(iwp) ::  nxrc                !<
1525    INTEGER(iwp) ::  nxrf                !<
1526    INTEGER(iwp) ::  nxrpr               !<
1527    INTEGER(iwp) ::  nxr_on_file         !<
1528    INTEGER(iwp) ::  nync                !<
1529    INTEGER(iwp) ::  nynf                !<
1530    INTEGER(iwp) ::  nynpr               !<
1531    INTEGER(iwp) ::  nyn_on_file         !<
1532    INTEGER(iwp) ::  nysc                !<
1533    INTEGER(iwp) ::  nysf                !<
1534    INTEGER(iwp) ::  nyspr               !<
1535    INTEGER(iwp) ::  nys_on_file         !<
1536    INTEGER(iwp) ::  nzb_on_file         !<
1537    INTEGER(iwp) ::  nzt_on_file         !<
1538    INTEGER(iwp) ::  offset_x            !<
1539    INTEGER(iwp) ::  offset_y            !<
1540    INTEGER(iwp) ::  shift_x             !<
1541    INTEGER(iwp) ::  shift_y             !<
1542
1543    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  file_list       !<
1544    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  overlap_count   !<
1545
1546    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nxlfa      !<
1547    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nxrfa      !<
1548    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nynfa      !<
1549    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nysfa      !<
1550    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  offset_xa  !<
1551    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  offset_ya  !<
1552
1553    INTEGER(isp), DIMENSION(:,:),   ALLOCATABLE ::  tmp_2d_id_random   !< temporary array for storing random generator data
1554    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_2d_seq_random  !< temporary array for storing random generator data
1555
1556    LOGICAL ::  array_found                      !<
1557    LOGICAL ::  found                            !<
1558
1559    REAL(wp), DIMENSION(:,:),   ALLOCATABLE   ::  tmp_2d         !< temporary array for storing 2D data
1560    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d         !< temporary array for storing 3D data
1561    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d_non_standard !< temporary array for storing 3D data
1562                                                                 !< with non standard dimensions
1563
1564!
1565!-- Read data from previous model run.
1566    CALL cpu_log( log_point_s(14), 'read-restart-data-local', 'start' )
1567
1568    CALL location_message( 'reading local restart data', 'start' )
1569
1570    IF ( TRIM( restart_data_format_input ) == 'fortran_binary' )  THEN
1571!
1572!--    Input in Fortran binary format
1573
1574!
1575!--    Allocate temporary buffer arrays. In previous versions, they were
1576!--    declared as automated arrays, causing memory problems when these
1577!--    were allocate on stack.
1578       ALLOCATE( nxlfa(numprocs_previous_run,1000) )
1579       ALLOCATE( nxrfa(numprocs_previous_run,1000) )
1580       ALLOCATE( nynfa(numprocs_previous_run,1000) )
1581       ALLOCATE( nysfa(numprocs_previous_run,1000) )
1582       ALLOCATE( offset_xa(numprocs_previous_run,1000) )
1583       ALLOCATE( offset_ya(numprocs_previous_run,1000) )
1584
1585!
1586!--    Check which of the restart files contain data needed for the subdomain
1587!--    of this PE
1588       files_to_be_opened = 0
1589
1590       DO  i = 1, numprocs_previous_run
1591!
1592!--       Store array bounds of the previous run ("pr") in temporary scalars
1593          nxlpr = hor_index_bounds_previous_run(1,i-1)
1594          nxrpr = hor_index_bounds_previous_run(2,i-1)
1595          nyspr = hor_index_bounds_previous_run(3,i-1)
1596          nynpr = hor_index_bounds_previous_run(4,i-1)
1597
1598!
1599!--       Determine the offsets. They may be non-zero in case that the total domain
1600!--       on file is smaller than the current total domain.
1601          offset_x = ( nxl / ( nx_on_file + 1 ) ) * ( nx_on_file + 1 )
1602          offset_y = ( nys / ( ny_on_file + 1 ) ) * ( ny_on_file + 1 )
1603
1604!
1605!--       Start with this offset and then check, if the subdomain on file
1606!--       matches another time(s) in the current subdomain by shifting it
1607!--       for nx_on_file+1, ny_on_file+1 respectively
1608
1609          shift_y = 0
1610          j       = 0
1611          DO WHILE (  nyspr+shift_y <= nyn-offset_y )
1612
1613             IF ( nynpr+shift_y >= nys-offset_y ) THEN
1614
1615                shift_x = 0
1616                DO WHILE ( nxlpr+shift_x <= nxr-offset_x )
1617
1618                   IF ( nxrpr+shift_x >= nxl-offset_x ) THEN
1619                      j = j +1
1620                      IF ( j > 1000 )  THEN
1621!
1622!--                      Array bound exceeded
1623                         message_string = 'data from subdomain of previous' //                        &
1624                                          ' run mapped more than 1000 times'
1625                         CALL message( 'rrd_local', 'PA0284', 2, 2, -1, 6, 1 )
1626                      ENDIF
1627
1628                      IF ( j == 1 )  THEN
1629                         files_to_be_opened = files_to_be_opened + 1
1630                         file_list(files_to_be_opened) = i-1
1631                      ENDIF
1632
1633                      offset_xa(files_to_be_opened,j) = offset_x + shift_x
1634                      offset_ya(files_to_be_opened,j) = offset_y + shift_y
1635!
1636!--                   Index bounds of overlapping data
1637                      nxlfa(files_to_be_opened,j) = MAX( nxl-offset_x-shift_x, nxlpr )
1638                      nxrfa(files_to_be_opened,j) = MIN( nxr-offset_x-shift_x, nxrpr )
1639                      nysfa(files_to_be_opened,j) = MAX( nys-offset_y-shift_y, nyspr )
1640                      nynfa(files_to_be_opened,j) = MIN( nyn-offset_y-shift_y, nynpr )
1641
1642                   ENDIF
1643
1644                   shift_x = shift_x + ( nx_on_file + 1 )
1645                ENDDO
1646
1647             ENDIF
1648
1649             shift_y = shift_y + ( ny_on_file + 1 )
1650          ENDDO
1651
1652          IF ( j > 0 )  overlap_count(files_to_be_opened) = j
1653
1654       ENDDO
1655
1656!
1657!--    Save the id-string of the current process, since myid_char may now be used
1658!--    to open files created by PEs with other id.
1659       myid_char_save = myid_char
1660
1661       IF ( files_to_be_opened /= 1  .OR.  numprocs /= numprocs_previous_run )  THEN
1662          WRITE( message_string, * ) 'number of PEs or virtual PE-grid changed in restart run. & ',   &
1663                                     'Set debug_output =.T. to get a list of files from which the & ',&
1664                                     'single PEs will read respectively'
1665          CALL message( 'rrd_local', 'PA0285', 0, 0, 0, 6, 0 )
1666          IF ( debug_output )  THEN
1667             IF ( files_to_be_opened <= 120 )  THEN
1668                WRITE( debug_string, '(2A,1X,120(I6.6,1X))' )                                         &
1669                     'number of PEs or virtual PE-grid changed in restart run.  PE will read from ',  &
1670                     'files ', file_list(1:files_to_be_opened)
1671             ELSE
1672                WRITE( debug_string, '(3A,1X,120(I6.6,1X),A)' )                                      &
1673                     'number of PEs or virtual PE-grid changed in restart run.  PE will read from ',  &
1674                     'files ', file_list(1:120), '... and more'
1675             ENDIF
1676             CALL debug_message( 'rrd_local', 'info' )
1677          ENDIF
1678       ENDIF
1679
1680!
1681!--    Read data from all restart files determined above
1682       DO  i = 1, files_to_be_opened
1683
1684          j = file_list(i)
1685!
1686!--       Set the filename (underscore followed by four digit processor id)
1687          WRITE (myid_char,'(''_'',I6.6)')  j
1688
1689!
1690!--       Open the restart file. If this file has been created by PE0 (_000000),
1691!--       the global variables at the beginning of the file have to be skipped
1692!--       first.
1693          CALL check_open( 13 )
1694          IF ( j == 0 )  CALL rrd_skip_global
1695
1696!
1697!--       First compare the version numbers
1698          READ ( 13 )  length
1699          READ ( 13 )  restart_string(1:length)
1700          READ ( 13 )  version_on_file
1701
1702          binary_version_local = '5.0'
1703          IF ( TRIM( version_on_file ) /= TRIM( binary_version_local ) )  THEN
1704             WRITE( message_string, * ) 'version mismatch concerning ',                               &
1705                                        'binary_version_local:',                                      &
1706                                        '&version on file    = "', TRIM( version_on_file ), '"',      &
1707                                        '&version in program = "', TRIM( binary_version_local ), '"'
1708             CALL message( 'rrd_local', 'PA0286', 1, 2, 0, 6, 0 )
1709          ENDIF
1710
1711!
1712!--       Read number of processors, processor-id, and array ranges.
1713!--       Compare the array ranges with those stored in the index bound array.
1714          READ ( 13 )  numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, nys_on_file,         &
1715                       nyn_on_file, nzb_on_file, nzt_on_file
1716
1717          IF ( nxl_on_file /= hor_index_bounds_previous_run(1,j) )  THEN
1718             WRITE( message_string, * ) 'problem with index bound nxl on ',                           &
1719                                        'restart file "', myid_char, '"',                             &
1720                                        '&nxl = ', nxl_on_file, ' but it should be',                  &
1721                                        '&= ', hor_index_bounds_previous_run(1,j),                    &
1722                                        '&from the index bound information array'
1723             CALL message( 'rrd_local', 'PA0287', 2, 2, -1, 6, 1 )
1724          ENDIF
1725
1726          IF ( nxr_on_file /= hor_index_bounds_previous_run(2,j) )  THEN
1727              WRITE( message_string, * ) 'problem with index bound nxr on ',                          &
1728                                         'restart file "', myid_char, '"'  ,                          &
1729                                         ' nxr = ', nxr_on_file, ' but it should be',                 &
1730                                         ' = ', hor_index_bounds_previous_run(2,j),                   &
1731                                         ' from the index bound information array'
1732             CALL message( 'rrd_local', 'PA0288', 2, 2, -1, 6, 1 )
1733
1734          ENDIF
1735
1736          IF ( nys_on_file /= hor_index_bounds_previous_run(3,j) )  THEN
1737             WRITE( message_string, * ) 'problem with index bound nys on ',                           &
1738                                        'restart file "', myid_char, '"',                             &
1739                                        '&nys = ', nys_on_file, ' but it should be',                  &
1740                                        '&= ', hor_index_bounds_previous_run(3,j),                    &
1741                                        '&from the index bound information array'
1742             CALL message( 'rrd_local', 'PA0289', 2, 2, -1, 6, 1 )
1743          ENDIF
1744
1745          IF ( nyn_on_file /= hor_index_bounds_previous_run(4,j) )  THEN
1746             WRITE( message_string, * ) 'problem with index bound nyn on ',                           &
1747                                        'restart file "', myid_char, '"',                             &
1748                                        '&nyn = ', nyn_on_file, ' but it should be',                  &
1749                                        '&= ', hor_index_bounds_previous_run(4,j),                    &
1750                                        '&from the index bound information array'
1751             CALL message( 'rrd_local', 'PA0290', 2, 2, -1, 6, 1 )
1752          ENDIF
1753
1754          IF ( nzb_on_file /= nzb )  THEN
1755             WRITE( message_string, * ) 'mismatch between actual data and data ',                     &
1756                                        'from prior run on PE ', myid,                                &
1757                                        '&nzb on file = ', nzb_on_file,                               &
1758                                        '&nzb         = ', nzb
1759             CALL message( 'rrd_local', 'PA0291', 1, 2, 0, 6, 0 )
1760          ENDIF
1761
1762          IF ( nzt_on_file /= nzt )  THEN
1763             WRITE( message_string, * ) 'mismatch between actual data and data ',                     &
1764                                        'from prior run on PE ', myid,                                &
1765                                        '&nzt on file = ', nzt_on_file,                               &
1766                                        '&nzt         = ', nzt
1767             CALL message( 'rrd_local', 'PA0292', 1, 2, 0, 6, 0 )
1768          ENDIF
1769
1770!
1771!--       Allocate temporary arrays sized as the arrays on the restart file
1772          ALLOCATE( tmp_2d(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp),      &
1773                    tmp_3d(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,                               &
1774                           nxl_on_file-nbgp:nxr_on_file+nbgp) )
1775
1776!
1777!--       Read arrays
1778!--       ATTENTION: If the following read commands have been altered, the
1779!--       ---------- version number of the variable binary_version_local must
1780!--                  be altered, too. Furthermore, the output list of arrays in
1781!--                  wrd_write_local must also be altered
1782!--                  accordingly.
1783          READ ( 13 )  length
1784          READ ( 13 )  restart_string(1:length)
1785
1786
1787!
1788!--       Loop over processor specific field data
1789          DO  WHILE ( restart_string(1:length) /= '*** end ***' )
1790
1791!
1792!--          Map data on file as often as needed (data are read only for k=1)
1793             DO  k = 1, overlap_count(i)
1794
1795                found = .FALSE.
1796
1797!
1798!--             Get the index range of the subdomain on file which overlap with
1799!--             the current subdomain
1800                nxlf = nxlfa(i,k)
1801                nxlc = nxlfa(i,k) + offset_xa(i,k)
1802                nxrf = nxrfa(i,k)
1803                nxrc = nxrfa(i,k) + offset_xa(i,k)
1804                nysf = nysfa(i,k)
1805                nysc = nysfa(i,k) + offset_ya(i,k)
1806                nynf = nynfa(i,k)
1807                nync = nynfa(i,k) + offset_ya(i,k)
1808
1809
1810                SELECT CASE ( restart_string(1:length) )
1811
1812                   CASE ( 'ghf_av' )
1813                      IF ( .NOT. ALLOCATED( ghf_av ) )  THEN
1814                         ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
1815                      ENDIF
1816                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1817                      ghf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1818                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1819
1820                   CASE ( 'e' )
1821                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1822                      e(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
1823                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1824
1825                   CASE ( 'e_av' )
1826                      IF ( .NOT. ALLOCATED( e_av ) )  THEN
1827                         ALLOCATE( e_av(nzb:nzt+1,nys-nbgp:nyn+nbgp,                                  &
1828                                        nxl-nbgp:nxr+nbgp) )
1829                      ENDIF
1830                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1831                      e_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1832                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1833
1834                   CASE ( 'kh' )
1835                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1836                      kh(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
1837                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1838
1839                   CASE ( 'kh_av' )
1840                      IF ( .NOT. ALLOCATED( kh_av ) )  THEN
1841                         ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
1842                      ENDIF
1843                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1844                      kh_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
1845                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1846
1847                   CASE ( 'km' )
1848                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1849                      km(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
1850                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1851
1852                   CASE ( 'km_av' )
1853                      IF ( .NOT. ALLOCATED( km_av ) )  THEN
1854                         ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
1855                      ENDIF
1856                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1857                      km_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
1858                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1859
1860                   CASE ( 'lpt_av' )
1861                      IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
1862                         ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
1863                      ENDIF
1864                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1865                      lpt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
1866                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1867
1868                   CASE ( 'lwp_av' )
1869                      IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
1870                         ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
1871                      ENDIF
1872                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1873                      lwp_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1874                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1875
1876                   CASE ( 'p' )
1877                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1878                      p(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
1879                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1880
1881                   CASE ( 'p_av' )
1882                      IF ( .NOT. ALLOCATED( p_av ) )  THEN
1883                         ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1884                      ENDIF
1885                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1886                      p_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1887                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1888
1889                   CASE ( 'pt' )
1890                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1891                      pt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
1892                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1893
1894                   CASE ( 'pt_av' )
1895                      IF ( .NOT. ALLOCATED( pt_av ) )  THEN
1896                         ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1897                      ENDIF
1898                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1899                      pt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
1900                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1901
1902                   CASE ( 'q' )
1903                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1904                      q(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
1905                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1906
1907                   CASE ( 'q_av' )
1908                      IF ( .NOT. ALLOCATED( q_av ) )  THEN
1909                         ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
1910                      ENDIF
1911                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1912                      q_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1913                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1914
1915                   CASE ( 'ql' )
1916                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1917                      ql(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                 &
1918                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1919
1920                   CASE ( 'ql_av' )
1921                      IF ( .NOT. ALLOCATED( ql_av ) )  THEN
1922                         ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1923                      ENDIF
1924                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1925                      ql_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
1926                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1927
1928                   CASE ( 'qsurf_av' )
1929                      IF ( .NOT. ALLOCATED( qsurf_av ) )  THEN
1930                         ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
1931                      ENDIF
1932                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1933                      qsurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
1934                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1935
1936                   CASE ( 'qsws_av' )
1937                      IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
1938                         ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
1939                      ENDIF
1940                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1941                      qsws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                             &
1942                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1943
1944                   CASE ( 'qv_av' )
1945                      IF ( .NOT. ALLOCATED( qv_av ) )  THEN
1946                         ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1947                      ENDIF
1948                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1949                      qv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                              &
1950                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1951
1952                   CASE ( 'r_a_av' )
1953                      IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
1954                         ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
1955                      ENDIF
1956                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1957                      r_a_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1958                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1959
1960                   CASE ( 'random_iv' )  ! still unresolved issue
1961                      IF ( k == 1 )  READ ( 13 )  random_iv
1962                      IF ( k == 1 )  READ ( 13 )  random_iy
1963
1964                   CASE ( 'seq_random_array' )
1965                      ALLOCATE( tmp_2d_id_random(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
1966                      ALLOCATE( tmp_2d_seq_random(5,nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
1967                      IF ( .NOT. ALLOCATED( id_random_array ) )  THEN
1968                         ALLOCATE( id_random_array(nys:nyn,nxl:nxr) )
1969                      ENDIF
1970                      IF ( .NOT. ALLOCATED( seq_random_array ) )  THEN
1971                         ALLOCATE( seq_random_array(5,nys:nyn,nxl:nxr) )
1972                      ENDIF
1973                      IF ( k == 1 )  READ ( 13 )  tmp_2d_id_random
1974                      IF ( k == 1 )  READ ( 13 )  tmp_2d_seq_random
1975                      id_random_array(nysc:nync,nxlc:nxrc) = tmp_2d_id_random(nysf:nynf,nxlf:nxrf)
1976                      seq_random_array(:,nysc:nync,nxlc:nxrc) = tmp_2d_seq_random(:,nysf:nynf,nxlf:nxrf)
1977                      DEALLOCATE( tmp_2d_id_random, tmp_2d_seq_random )
1978
1979                   CASE ( 's' )
1980                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1981                      s(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
1982                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1983
1984                   CASE ( 's_av' )
1985                      IF ( .NOT. ALLOCATED( s_av ) )  THEN
1986                         ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
1987                      ENDIF
1988                      IF ( k == 1 )  READ ( 13 )  tmp_3d
1989                      s_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
1990                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1991
1992                   CASE ( 'shf_av' )
1993                      IF ( .NOT. ALLOCATED( shf_av ) )  THEN
1994                         ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
1995                      ENDIF
1996                      IF ( k == 1 )  READ ( 13 )  tmp_2d
1997                      shf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
1998                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1999
2000                   CASE ( 'ssurf_av' )
2001                      IF ( .NOT. ALLOCATED( ssurf_av ) )  THEN
2002                         ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
2003                      ENDIF
2004                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2005                      ssurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
2006                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2007
2008                   CASE ( 'ssws_av' )
2009                      IF ( .NOT. ALLOCATED( ssws_av ) )  THEN
2010                         ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
2011                      ENDIF
2012                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2013                      ssws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                             &
2014                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2015
2016                   CASE ( 'ts_av' )
2017                      IF ( .NOT. ALLOCATED( ts_av ) )  THEN
2018                         ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
2019                      ENDIF
2020                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2021                      ts_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
2022                           tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2023
2024                   CASE ( 'tsurf_av' )
2025                      IF ( .NOT. ALLOCATED( tsurf_av ) )  THEN
2026                         ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
2027                      ENDIF
2028                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2029                      tsurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
2030                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2031
2032                   CASE ( 'u' )
2033                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2034                      u(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2035                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2036
2037                   CASE ( 'u_av' )
2038                      IF ( .NOT. ALLOCATED( u_av ) )  THEN
2039                         ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2040                      ENDIF
2041                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2042                      u_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
2043                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2044
2045                   CASE ( 'u_m_l' )
2046                      IF ( k == 1 )  THEN
2047                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2048                                                       1:2) )
2049                         READ ( 13 )  tmp_3d_non_standard
2050                      ENDIF
2051                      IF ( bc_radiation_l )  THEN
2052                         u_m_l(:,nysc-nbgp:nync+nbgp,:) =  tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2053                      ENDIF
2054
2055                   CASE ( 'u_m_n' )
2056                      IF ( k == 1 )  THEN
2057                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,ny-1:ny,                             &
2058                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2059                         READ ( 13 )  tmp_3d_non_standard
2060                      ENDIF
2061                      IF ( bc_radiation_n )  THEN
2062                         u_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2063                      ENDIF
2064
2065                   CASE ( 'u_m_r' )
2066                      IF ( k == 1 )  THEN
2067                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2068                                                       nx-1:nx) )
2069                         READ ( 13 )  tmp_3d_non_standard
2070                      ENDIF
2071                      IF ( bc_radiation_r )  THEN
2072                         u_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2073                      ENDIF
2074
2075                   CASE ( 'u_m_s' )
2076                      IF ( k == 1 )  THEN
2077                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,0:1,                                 &
2078                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2079                         READ ( 13 )  tmp_3d_non_standard
2080                      ENDIF
2081                      IF ( bc_radiation_s )  THEN
2082                         u_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2083                      ENDIF
2084
2085                   CASE ( 'us_av' )
2086                      IF ( .NOT. ALLOCATED( us_av ) )  THEN
2087                         ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
2088                      ENDIF
2089                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2090                      us_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
2091                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2092
2093                   CASE ( 'v' )
2094                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2095                      v(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2096                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2097
2098                   CASE ( 'v_av' )
2099                      IF ( .NOT. ALLOCATED( v_av ) )  THEN
2100                         ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2101                      ENDIF
2102                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2103                      v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
2104                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2105
2106                   CASE ( 'v_m_l' )
2107                      IF ( k == 1 )  THEN
2108                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2109                                                       0:1) )
2110                         READ ( 13 )  tmp_3d_non_standard
2111                      ENDIF
2112                      IF ( bc_radiation_l )  THEN
2113                         v_m_l(:,nysc-nbgp:nync+nbgp,:) = tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2114                      ENDIF
2115
2116                   CASE ( 'v_m_n' )
2117                      IF ( k == 1 )  THEN
2118                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,ny-1:ny,                             &
2119                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2120                         READ ( 13 )  tmp_3d_non_standard
2121                      ENDIF
2122                      IF ( bc_radiation_n )  THEN
2123                         v_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2124                      ENDIF
2125
2126                   CASE ( 'v_m_r' )
2127                      IF ( k == 1 )  THEN
2128                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2129                                                       nx-1:nx) )
2130                         READ ( 13 )  tmp_3d_non_standard
2131                      ENDIF
2132                      IF ( bc_radiation_r )  THEN
2133                         v_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2134                      ENDIF
2135
2136                   CASE ( 'v_m_s' )
2137                      IF ( k == 1 )  THEN
2138                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,1:2,                                 &
2139                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2140                         READ ( 13 )  tmp_3d_non_standard
2141                      ENDIF
2142                      IF ( bc_radiation_s )  THEN
2143                         v_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2144                      ENDIF
2145
2146                   CASE ( 'vpt' )
2147                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2148                      vpt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                &
2149                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2150
2151                   CASE ( 'vpt_av' )
2152                      IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
2153                         ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2154                      ENDIF
2155                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2156                      vpt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                             &
2157                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2158
2159                   CASE ( 'w' )
2160                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2161                      w(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                  &
2162                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2163
2164                   CASE ( 'w_av' )
2165                      IF ( .NOT. ALLOCATED( w_av ) )  THEN
2166                         ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2167                      ENDIF
2168                      IF ( k == 1 )  READ ( 13 )  tmp_3d
2169                      w_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                               &
2170                         tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2171
2172                   CASE ( 'w_m_l' )
2173                      IF ( k == 1 )  THEN
2174                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2175                                                       0:1) )
2176                         READ ( 13 )  tmp_3d_non_standard
2177                      ENDIF
2178                      IF ( bc_radiation_l )  THEN
2179                         w_m_l(:,nysc-nbgp:nync+nbgp,:) = tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2180                      ENDIF
2181
2182                   CASE ( 'w_m_n' )
2183                      IF ( k == 1 )  THEN
2184                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,ny-1:ny,                             &
2185                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2186                         READ ( 13 )  tmp_3d_non_standard
2187                      ENDIF
2188                      IF ( bc_radiation_n )  THEN
2189                         w_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2190                      ENDIF
2191
2192                   CASE ( 'w_m_r' )
2193                      IF ( k == 1 )  THEN
2194                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,   &
2195                                                       nx-1:nx) )
2196                         READ ( 13 )  tmp_3d_non_standard
2197                      ENDIF
2198                      IF ( bc_radiation_r )  THEN
2199                         w_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3d_non_standard(:,nysf-nbgp:nynf+nbgp,:)
2200                      ENDIF
2201
2202                   CASE ( 'w_m_s' )
2203                      IF ( k == 1 )  THEN
2204                         ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,0:1,                                 &
2205                                                       nxl_on_file-nbgp:nxr_on_file+nbgp) )
2206                         READ ( 13 )  tmp_3d_non_standard
2207                      ENDIF
2208                      IF ( bc_radiation_s )  THEN
2209                         w_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp)
2210                      ENDIF
2211
2212                   CASE ( 'z0_av' )
2213                      IF ( .NOT. ALLOCATED( z0_av ) )  THEN
2214                         ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
2215                      ENDIF
2216                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2217                      z0_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                               &
2218                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2219
2220                   CASE ( 'z0h_av' )
2221                      IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
2222                         ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
2223                      ENDIF
2224                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2225                      z0h_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
2226                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2227
2228                   CASE ( 'z0q_av' )
2229                      IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
2230                         ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
2231                      ENDIF
2232                      IF ( k == 1 )  READ ( 13 )  tmp_2d
2233                      z0q_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =                              &
2234                      tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2235
2236                   CASE DEFAULT
2237
2238!
2239!--                   Read restart data of surfaces
2240                      IF ( .NOT. found )  CALL surface_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf,   &
2241                                                                  nxr_on_file, nynf, nyn_on_file,     &
2242                                                                  nysf, nysc, nys_on_file, found )
2243!
2244!--                   Read restart data of other modules
2245                      IF ( .NOT. found ) CALL module_interface_rrd_local(                             &
2246                                                                  k, nxlf, nxlc, nxl_on_file, nxrf,   &
2247                                                                  nxrc, nxr_on_file, nynf, nync,      &
2248                                                                  nyn_on_file, nysf, nysc,            &
2249                                                                  nys_on_file, tmp_2d, tmp_3d, found )
2250
2251
2252                      IF ( .NOT. found )  THEN
2253                         WRITE( message_string, * ) 'unknown variable named "',                       &
2254                                                    restart_string(1:length),                         &
2255                                                   '" found in subdomain data ',                      &
2256                                                   'from prior run on PE ', myid
2257                         CALL message( 'rrd_local', 'PA0302', 1, 2, 0, 6, 0 )
2258
2259                      ENDIF
2260
2261                END SELECT
2262
2263             ENDDO ! overlaploop
2264
2265!
2266!--          Deallocate non standard array needed for specific variables only
2267             IF ( ALLOCATED( tmp_3d_non_standard ) )  DEALLOCATE( tmp_3d_non_standard )
2268
2269!
2270!--          Read next character string
2271             READ ( 13 )  length
2272             READ ( 13 )  restart_string(1:length)
2273
2274          ENDDO ! dataloop
2275!
2276!--       Close the restart file
2277          CALL close_file( 13 )
2278
2279          DEALLOCATE( tmp_2d, tmp_3d )
2280
2281       ENDDO  ! loop over restart files
2282!
2283!--    Deallocate temporary buffer arrays
2284       DEALLOCATE( nxlfa )
2285       DEALLOCATE( nxrfa )
2286       DEALLOCATE( nynfa )
2287       DEALLOCATE( nysfa )
2288       DEALLOCATE( offset_xa )
2289       DEALLOCATE( offset_ya )
2290!
2291!--    Restore the original filename for the restart file to be written
2292       myid_char = myid_char_save
2293
2294
2295    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
2296
2297!
2298!--    Read local restart data using MPI-IO
2299!
2300!--    Open the MPI-IO restart file.
2301       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ) )
2302
2303
2304       CALL rd_mpi_io_check_array( 'ghf_av' , found = array_found )
2305       IF ( array_found )  THEN
2306          IF (.NOT. ALLOCATED( ghf_av ) )  ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
2307          CALL rrd_mpi_io( 'ghf_av', ghf_av )
2308       ENDIF
2309
2310       CALL rrd_mpi_io( 'e', e )
2311
2312       CALL rd_mpi_io_check_array( 'e_av' , found = array_found )
2313       IF ( array_found  )  THEN
2314          IF ( .NOT. ALLOCATED( e_av ) )  ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2315          CALL rrd_mpi_io( 'e_av', e_av )
2316       ENDIF
2317
2318       CALL rrd_mpi_io( 'kh', kh )
2319
2320       CALL rd_mpi_io_check_array( 'kh_av' , found = array_found )
2321       IF ( array_found )  THEN
2322          IF ( .NOT. ALLOCATED( kh_av ) )  ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2323          CALL rrd_mpi_io( 'kh_av', kh_av )
2324       ENDIF
2325
2326       CALL rrd_mpi_io( 'km' , km)
2327
2328       CALL rd_mpi_io_check_array( 'km_av' , found = array_found )
2329       IF ( array_found )  THEN
2330          IF ( .NOT. ALLOCATED( km_av ) )  ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2331          CALL rrd_mpi_io( 'km_av', km_av )
2332       ENDIF
2333
2334       CALL rd_mpi_io_check_array( 'lpt_av' , found = array_found )
2335       IF ( array_found )  THEN
2336          IF ( .NOT. ALLOCATED( lpt_av ) )  ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2337          CALL rrd_mpi_io( 'lpt_av', lpt_av )
2338       ENDIF
2339
2340       CALL rd_mpi_io_check_array( 'lwp_av' , found = array_found )
2341       IF ( array_found )  THEN
2342          IF ( .NOT. ALLOCATED( lwp_av ) )  ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
2343          CALL rrd_mpi_io( 'lwp_av', lwp_av )
2344       ENDIF
2345
2346       CALL rrd_mpi_io( 'p', p)
2347
2348       CALL rd_mpi_io_check_array( 'p_av' , found = array_found )
2349       IF ( array_found )  THEN
2350          IF ( .NOT. ALLOCATED( p_av ) )  ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2351          CALL rrd_mpi_io( 'p_av', p_av )
2352       ENDIF
2353
2354       CALL rrd_mpi_io( 'pt', pt)
2355
2356       CALL rd_mpi_io_check_array( 'pt_av' , found = array_found )
2357       IF ( array_found )  THEN
2358          IF ( .NOT. ALLOCATED( pt_av ) )  ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2359          CALL rrd_mpi_io( 'pt_av', pt_av )
2360       ENDIF
2361
2362       CALL rd_mpi_io_check_array( 'q' , found = array_found )
2363       IF ( array_found )  THEN
2364          CALL rrd_mpi_io( 'q', q )
2365       ENDIF
2366
2367       CALL rd_mpi_io_check_array( 'q_av' , found = array_found )
2368       IF ( array_found )  THEN
2369          IF ( .NOT. ALLOCATED( q_av ) )  ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2370          CALL rrd_mpi_io( 'q_av', q_av )
2371       ENDIF
2372
2373       CALL rd_mpi_io_check_array( 'ql' , found = array_found )
2374       IF ( array_found )  THEN
2375          CALL rrd_mpi_io( 'ql', ql )
2376       ENDIF
2377
2378       CALL rd_mpi_io_check_array( 'ql_av' , found = array_found )
2379       IF ( array_found )  THEN
2380          IF ( .NOT. ALLOCATED( ql_av ) )  ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2381          CALL rrd_mpi_io( 'ql_av', ql_av )
2382       ENDIF
2383
2384       CALL rd_mpi_io_check_array( 'qsurf_av' , found = array_found )
2385       IF ( array_found )  THEN
2386          IF ( .NOT. ALLOCATED( qsurf_av ) )  ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
2387          CALL rrd_mpi_io( 'qsurf_av', qsurf_av )
2388       ENDIF
2389
2390       CALL rd_mpi_io_check_array( 'qsws_av' , found = array_found )
2391       IF ( array_found )  THEN
2392          IF ( .NOT. ALLOCATED( qsws_av ) )  ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
2393          CALL rrd_mpi_io( 'qsws_av', qsws_av )
2394       ENDIF
2395
2396       CALL rd_mpi_io_check_array( 'qv_av' , found = array_found )
2397       IF ( array_found )  THEN
2398          IF ( .NOT. ALLOCATED( qv_av ) )  ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2399          CALL rrd_mpi_io( 'qv_av', qv_av )
2400       ENDIF
2401
2402       CALL rd_mpi_io_check_array( 'r_a_av' , found = array_found )
2403       IF ( array_found )  THEN
2404          IF ( .NOT. ALLOCATED( r_a_av ) )  ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
2405          CALL rrd_mpi_io( 'r_a_av', r_a_av )
2406       ENDIF
2407
2408!
2409!--    ATTENTION: The random seeds are global data! If independent values for every PE are required,
2410!--    the general approach of PE indendent restart will be lost. That means that in general the
2411!--    parallel random number generator in random_generator_parallel_mod should be used!
2412       CALL rrd_mpi_io_global_array( 'random_iv', random_iv )
2413       CALL rrd_mpi_io( 'random_iy', random_iy )
2414
2415       CALL rd_mpi_io_check_array( 'id_random_array' , found = array_found )
2416       IF ( array_found )  THEN
2417          IF ( .NOT. ALLOCATED( id_random_array ) )  ALLOCATE( id_random_array(nys:nyn,nxl:nxr) )
2418          IF ( .NOT. ALLOCATED( seq_random_array ) )  ALLOCATE( seq_random_array(5,nys:nyn,nxl:nxr) )
2419          CALL rrd_mpi_io( 'id_random_array', id_random_array)
2420          DO  i = 1, SIZE( seq_random_array, 1 )
2421             WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array', i
2422             CALL rrd_mpi_io( TRIM(tmp_name), seq_random_array(i,:,:) )
2423          ENDDO
2424       ENDIF
2425
2426       CALL rd_mpi_io_check_array( 's' , found = array_found )
2427       IF ( array_found )  THEN
2428          CALL rrd_mpi_io( 's', s )
2429       ENDIF
2430
2431       CALL rd_mpi_io_check_array( 's_av' , found = array_found )
2432       IF ( array_found )  THEN
2433          IF ( .NOT. ALLOCATED( s_av ) )  ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2434          CALL rrd_mpi_io( 's_av', s_av )
2435       ENDIF
2436
2437       CALL rd_mpi_io_check_array( 'shf_av' , found = array_found )
2438       IF ( array_found )  THEN
2439          IF ( .NOT. ALLOCATED( shf_av ) )  ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
2440          CALL rrd_mpi_io( 'shf_av', shf_av )
2441       ENDIF
2442
2443       CALL rd_mpi_io_check_array( 'ssurf_av' , found = array_found )
2444       IF ( array_found )  THEN
2445          IF ( .NOT. ALLOCATED( ssurf_av ) )  ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
2446          CALL rrd_mpi_io( 'ssurf_av', ssurf_av )
2447       ENDIF
2448
2449       CALL rd_mpi_io_check_array( 'ssws_av' , found = array_found )
2450       IF ( array_found )  THEN
2451          IF ( .NOT. ALLOCATED( ssws_av ) )  ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
2452          CALL rrd_mpi_io( 'ssws_av', ssws_av )
2453       ENDIF
2454
2455       CALL rd_mpi_io_check_array( 'ts_av' , found = array_found )
2456       IF ( array_found )  THEN
2457          IF ( .NOT. ALLOCATED( ts_av ) )  ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
2458          CALL rrd_mpi_io( 'ts_av', ts_av )
2459       ENDIF
2460
2461       CALL rd_mpi_io_check_array( 'tsurf_av' , found = array_found )
2462       IF ( array_found )  THEN
2463          IF ( .NOT. ALLOCATED( tsurf_av ) )  ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
2464          CALL rrd_mpi_io( 'tsurf_av', tsurf_av )
2465       ENDIF
2466
2467       CALL rrd_mpi_io( 'u', u)
2468
2469       CALL rd_mpi_io_check_array( 'u_av' , found = array_found )
2470       IF ( array_found )  THEN
2471          IF ( .NOT. ALLOCATED( u_av ) )  ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2472          CALL rrd_mpi_io( 'u_av', u_av )
2473       ENDIF
2474
2475       CALL rd_mpi_io_check_array( 'u_m_l' , found = array_found )
2476       IF ( array_found )  THEN
2477          IF ( .NOT. ALLOCATED( u_m_l ) )  ALLOCATE( u_m_l(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2478          CALL rrd_mpi_io( 'u_m_l', u_m_l )
2479       ENDIF
2480
2481       CALL rd_mpi_io_check_array( 'u_m_n' , found = array_found )
2482       IF ( array_found )  THEN
2483          IF ( .NOT. ALLOCATED( u_m_n ) )  ALLOCATE( u_m_n(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2484          CALL rrd_mpi_io( 'u_m_n', u_m_n )
2485       ENDIF
2486
2487       CALL rd_mpi_io_check_array( 'u_m_r' , found = array_found )
2488       IF ( array_found )  THEN
2489          IF ( .NOT. ALLOCATED( u_m_r ) )  ALLOCATE( u_m_r(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2490          CALL rrd_mpi_io( 'u_m_r', u_m_r )
2491       ENDIF
2492
2493       CALL rd_mpi_io_check_array( 'u_m_s' , found = array_found )
2494       IF ( array_found )  THEN
2495          IF ( .NOT. ALLOCATED( u_m_s ) )  ALLOCATE( u_m_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2496          CALL rrd_mpi_io( 'u_m_s', u_m_s )
2497       ENDIF
2498
2499       CALL rd_mpi_io_check_array( 'us_av' , found = array_found )
2500       IF ( array_found )  THEN
2501          IF ( .NOT. ALLOCATED( us_av ) )  ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
2502          CALL rrd_mpi_io( 'us_av', us_av )
2503       ENDIF
2504
2505       CALL rrd_mpi_io( 'v', v )
2506
2507       CALL rd_mpi_io_check_array( 'v_av' , found = array_found )
2508       IF ( array_found )  THEN
2509          IF ( .NOT. ALLOCATED( v_av ) )  ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2510          CALL rrd_mpi_io( 'v_av', v_av )
2511       ENDIF
2512
2513       CALL rd_mpi_io_check_array( 'v_m_l' , found = array_found )
2514       IF ( array_found )  THEN
2515          IF ( .NOT. ALLOCATED( v_m_l ) )  ALLOCATE( v_m_l(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2516          CALL rrd_mpi_io( 'v_m_l', v_m_l )
2517       ENDIF
2518
2519       CALL rd_mpi_io_check_array( 'v_m_n' , found = array_found )
2520       IF ( array_found )  THEN
2521          IF ( .NOT. ALLOCATED( v_m_n ) )  ALLOCATE( v_m_n(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2522          CALL rrd_mpi_io( 'v_m_n', v_m_n )
2523       ENDIF
2524
2525       CALL rd_mpi_io_check_array( 'v_m_r' , found = array_found )
2526       IF ( array_found )  THEN
2527          IF ( .NOT. ALLOCATED( v_m_r ) )  ALLOCATE( v_m_r(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2528          CALL rrd_mpi_io( 'v_m_r', v_m_r )
2529       ENDIF
2530
2531       CALL rd_mpi_io_check_array( 'v_m_s' , found = array_found )
2532       IF ( array_found )  THEN
2533          IF ( .NOT. ALLOCATED( v_m_s ) )  ALLOCATE( v_m_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2534          CALL rrd_mpi_io( 'v_m_s', v_m_s )
2535       ENDIF
2536
2537       CALL rd_mpi_io_check_array( 'vpt' , found = array_found )
2538       IF ( array_found )  THEN
2539          CALL rrd_mpi_io( 'vpt',  vpt)
2540       ENDIF
2541
2542       CALL rd_mpi_io_check_array( 'vpt_av' , found = array_found )
2543       IF ( array_found )  THEN
2544          IF ( .NOT. ALLOCATED( vpt_av ) )  ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2545          CALL rrd_mpi_io( 'vpt_av', vpt_av )
2546       ENDIF
2547
2548       CALL rrd_mpi_io( 'w', w)
2549
2550       CALL rd_mpi_io_check_array( 'w_av' , found = array_found )
2551       IF ( array_found )  THEN
2552          IF ( .NOT. ALLOCATED( w_av ) )  ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2553          CALL rrd_mpi_io( 'w_av', w_av )
2554       ENDIF
2555
2556       CALL rd_mpi_io_check_array( 'w_m_l' , found = array_found )
2557       IF ( array_found )  THEN
2558          IF ( .NOT. ALLOCATED( w_m_l ) )  ALLOCATE( w_m_l(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2559          CALL rrd_mpi_io( 'w_m_l', w_m_l )
2560       ENDIF
2561
2562       CALL rd_mpi_io_check_array( 'w_m_n' , found = array_found )
2563       IF ( array_found )  THEN
2564          IF ( .NOT. ALLOCATED( w_m_n ) )  ALLOCATE( w_m_n(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2565          CALL rrd_mpi_io( 'w_m_n', w_m_n )
2566       ENDIF
2567
2568       CALL rd_mpi_io_check_array( 'w_m_r' , found = array_found )
2569       IF ( array_found )  THEN
2570          IF ( .NOT. ALLOCATED( w_m_r ) )  ALLOCATE( w_m_r(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2571          CALL rrd_mpi_io( 'w_m_r', w_m_r )
2572       ENDIF
2573
2574       CALL rd_mpi_io_check_array( 'w_m_s' , found = array_found )
2575       IF ( array_found )  THEN
2576          IF ( .NOT. ALLOCATED( w_m_s ) )  ALLOCATE( w_m_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2577          CALL rrd_mpi_io( 'w_m_s', w_m_s )
2578       ENDIF
2579
2580       CALL rd_mpi_io_check_array( 'z0_av' , found = array_found )
2581       IF ( array_found )  THEN
2582          IF ( .NOT. ALLOCATED( z0_av ) )  ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
2583          CALL rrd_mpi_io( 'z0_av', z0_av )
2584       ENDIF
2585
2586       CALL rd_mpi_io_check_array( 'z0h_av' , found = array_found )
2587       IF ( array_found )  THEN
2588          IF ( .NOT. ALLOCATED( z0h_av ) )  ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
2589          CALL rrd_mpi_io( 'z0h_av', z0h_av )
2590       ENDIF
2591
2592       CALL rd_mpi_io_check_array( 'z0q_av' , found = array_found )
2593       IF ( array_found )  THEN
2594          IF ( .NOT. ALLOCATED( z0q_av ) )  ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
2595          CALL rrd_mpi_io( 'z0q_av', z0q_av )
2596       ENDIF
2597
2598!
2599!--    Read restart data of surfaces
2600       CALL surface_rrd_local
2601
2602!
2603!--    Read restart data of other modules
2604       CALL module_interface_rrd_local
2605
2606!
2607!--    Close restart file
2608       CALL rd_mpi_io_close
2609
2610    ENDIF
2611
2612    CALL location_message( 'reading local restart data', 'finished' )
2613!
2614!-- End of time measuring for reading binary data
2615    CALL cpu_log( log_point_s(14), 'read-restart-data-local', 'stop' )
2616
2617 END SUBROUTINE rrd_local
2618
2619
2620!------------------------------------------------------------------------------!
2621! Description:
2622! ------------
2623!> Skipping the global control variables from restart-file (binary format)
2624!------------------------------------------------------------------------------!
2625 SUBROUTINE rrd_skip_global
2626
2627
2628    CHARACTER (LEN=1) ::  cdum
2629
2630
2631    READ ( 13 )  length
2632    READ ( 13 )  restart_string(1:length)
2633
2634    DO  WHILE ( restart_string(1:length) /= 'binary_version_local' )
2635
2636       READ ( 13 )  cdum
2637       READ ( 13 )  length
2638       READ ( 13 )  restart_string(1:length)
2639
2640    ENDDO
2641
2642    BACKSPACE ( 13 )
2643    BACKSPACE ( 13 )
2644
2645
2646 END SUBROUTINE rrd_skip_global
2647
2648
2649 END MODULE read_restart_data_mod
Note: See TracBrowser for help on using the repository browser.