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

Last change on this file since 4004 was 3998, checked in by suehring, 5 years ago

Bugfix in output module for diagnostic quantities

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