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

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

bugfix for message that reports about files that are read from in case that the virtual PE grid has chenged (in case of large number of files format was exceeded), detailed messages about the files are now output to the debug file, temporary bugfix to avoid compile problems with older NetCDFD libraries on IMUK machines

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