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

Last change on this file since 4421 was 4360, checked in by suehring, 4 years ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

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