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

Last change on this file since 4009 was 4009, checked in by raasch, 5 years ago

bugfix for r3998, allocation of 3d temporary arrays of various dimensions revised

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