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

Last change on this file since 3313 was 3298, checked in by kanani, 5 years ago

Merge chemistry branch at r3297 to trunk

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