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

Last change on this file since 3049 was 3049, checked in by Giersch, 6 years ago

Revision history corrected

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