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

Last change on this file since 3684 was 3668, checked in by maronga, 5 years ago

removed most_methods circular and lookup. added improved version of palm_csd

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