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

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

New diagnostic output for 10-m wind speed; Diagnostic output of 2-m potential temperature moved to diagnostic output

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