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

Last change on this file since 3196 was 3183, checked in by suehring, 6 years ago

last commit documented

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