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

Last change on this file since 3608 was 3589, checked in by suehring, 5 years ago

Remove erroneous UTF encoding; last commit documented

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