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

Last change on this file since 3938 was 3936, checked in by kanani, 5 years ago

Enable time-averaged output of theta_2m* with restarts

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