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

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

Code adjusted according to coding standards, renamed namelists, error messages revised until PA0347, output CASE 108 disabled

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