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

Last change on this file since 3833 was 3767, checked in by raasch, 5 years ago

unused variables removed from rrd-subroutines parameter list

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