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

Last change on this file since 4784 was 4777, checked in by raasch, 3 years ago

bugfix for reading/writing spectra data with MPI-I/O

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