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

Last change on this file since 4017 was 4017, checked in by schwenkel, 5 years ago

Modularization of all lagrangian particle model code components

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