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

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

Bugfix of the allocation of spectrum_x and spectrum_y in case of restart runs, spectrum_x and spectrum_y are now treat as global restart data not local

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