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

Last change on this file since 4514 was 4514, checked in by suehring, 4 years ago

Bugfix in plant-canopy model for output of averaged transpiration rate after a restart; Revise check for output for plant heating rate and rename error message number; Surface-data output: enable output of mixing ratio and passive scalar concentration at the surface; Surface-data input: Add possibility to prescribe surface sensible and latent heat fluxes via static input file

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