source: palm/trunk/SOURCE/read_var_list.f90 @ 2883

Last change on this file since 2883 was 2818, checked in by maronga, 6 years ago

improvements in spinup mechanism

  • Property svn:keywords set to Id
File size: 41.9 KB
Line 
1!> @file read_var_list.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_var_list.f90 2818 2018-02-19 16:42:36Z Giersch $
27! Added spinup_time to allow for restarts with spinup in precursor run.
28!
29! 2776 2018-01-31 10:44:42Z Giersch
30! Change skip_var_list: Skipping of module related parameter is only necessary
31! if restart data was outputted at the end of the precursor run
32!
33! 2718 2018-01-02 08:49:38Z maronga
34! Corrected "Former revisions" section
35!
36! 2696 2017-12-14 17:12:51Z kanani
37! Change in file header (GPL part)
38! + rans_mode, turbulence_closure (TG)
39!
40! 2576 2017-10-24 13:49:46Z Giersch
41! *** end *** marks the end of the standard parameter list of restart files
42! like it was before revision 2563. To skip also the variables of the modules 
43! wind_turbine_model_mod, flight_mod and synthetic_turbulence_generator_mod
44! three new functions has to be defined which are called in skip_var_list.
45! Adapted binary version number
46!
47! 2575 2017-10-24 09:57:58Z maronga
48! Renamed phi -> latitude, added longitude
49!
50! 2563 2017-10-19 15:36:10Z Giersch
51! CALL stg_read_restart_data moved to synthetic_turbulence_generator_mod and
52! CALL flight_read_restart_data moved to virtual_flights_mod. Furthermore
53! *** end default *** marks the end of the standard parameter list of restart
54! files and *** end *** marks the end of all parameter including module
55! parameter. Therefore the call of flight_skip_var_list becomes unnecessary.
56!
57! 2372 2017-08-25 12:37:32Z sward
58! y_shift added to vars, version no. increased
59!
60! 2365 2017-08-21 14:59:59Z kanani
61! Vertical grid nesting implemented (SadiqHuq)
62!
63! 2339 2017-08-07 13:55:26Z gronemeier
64! corrected timestamp in header
65!
66! 2338 2017-08-07 12:15:38Z gronemeier
67! Modularize 1D model
68!
69! 2320 2017-07-21 12:47:43Z suehring
70! Formatting adjustment
71!
72! 2265 2017-06-08 16:58:28Z schwenkel
73! Unused variables removed.
74!
75! 2259 2017-06-08 09:09:11Z gronemeier
76! Implemented synthetic turbulence generator
77!
78! 2233 2017-05-30 18:08:54Z suehring
79!
80! 2232 2017-05-30 17:47:52Z suehring
81! Replace wall_qflux, wall_sflux by wall_humidityflux and wall_scalarflux; add
82! wall_salinityflux
83! +tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,
84!  tunnel_wall_depth
85!
86! 2042 2016-11-02 13:47:31Z suehring
87! Bugfix, read restart data for wall_heatflux, wall_qflux and wall_sflux
88!
89! 2000 2016-08-20 18:09:15Z knoop
90! Forced header and separation lines into 80 columns
91!
92! 1992 2016-08-12 15:14:59Z suehring
93! top_scalarflux added
94!
95! 1960 2016-07-12 16:34:24Z suehring
96! Separate humidity and passive scalar
97! Remove unused variables from ONLY list
98!
99! 1957 2016-07-07 10:43:48Z suehring
100! flight module added
101!
102! 1849 2016-04-08 11:33:18Z hoffmann
103! Adapted for modularization of microphysics
104!
105! 1833 2016-04-07 14:23:03Z raasch
106! spectra_mod added
107!
108! 1831 2016-04-07 13:15:51Z hoffmann
109! turbulence renamed collision_turbulence, drizzle renamed
110! cloud_water_sedimentation
111!
112! 1808 2016-04-05 19:44:00Z raasch
113! test output removed
114!
115! 1783 2016-03-06 18:36:17Z raasch
116! netcdf module name changed + related changes
117!
118! 1699 2015-10-29 08:02:35Z maronga
119! Bugfix: update of binary version from 3.9b to 4.0 was missing
120!
121! 1691 2015-10-26 16:17:44Z maronga
122! Added output of most_method, constant_flux_layer, zeta_min, zeta_max. Removed
123! output of prandtl_layer and rif_min, rif_max.
124!
125! 1682 2015-10-07 23:56:08Z knoop
126! Code annotations made doxygen readable
127!
128! 1615 2015-07-08 18:49:19Z suehring
129! Enable turbulent inflow for passive_scalar and humidity
130!
131! 1585 2015-04-30 07:05:52Z maronga
132! Adapted for RRTMG
133!
134! 1560 2015-03-06 10:48:54Z keck
135! +recycling_yshift
136!
137! 1522 2015-01-14 10:53:12Z keck
138! added query for checking if the advection scheme in the restart run is the
139! same as the advection scheme in the corresponding initial run
140!
141! 1502 2014-12-03 18:22:31Z kanani
142! Canopy module and parameters removed (parameters are always read from
143! canopy_par NAMELIST for initial and restart runs)
144!
145! 1496 2014-12-02 17:25:50Z maronga
146! Renamed "radiation" -> "cloud_top_radiation"
147!
148! 1484 2014-10-21 10:53:05Z kanani
149! Changes in the course of the canopy-model modularization:
150!   parameters alpha_lad, beta_lad, lai_beta added,
151!   module plant_canopy_model_mod added,
152!   drag_coefficient, leaf_surface_concentration and scalar_exchange_coefficient
153!   renamed to canopy_drag_coeff, leaf_surface_conc and leaf_scalar_exch_coeff
154!
155! 1322 2014-03-20 16:38:49Z raasch
156! REAL functions provided with KIND-attribute
157!
158! 1320 2014-03-20 08:40:49Z raasch
159! ONLY-attribute added to USE-statements,
160! kind-parameters added to all INTEGER and REAL declaration statements,
161! kinds are defined in new module kinds,
162! old module precision_kind is removed,
163! revision history before 2012 removed,
164! comment fields (!:) to be used for variable explanations added to
165! all variable declaration statements
166!
167! 1308 2014-03-13 14:58:42Z fricke
168! +do2d_xy_time_count, do2d_xz_time_count, do2d_yz_time_count,
169! +do3d_time_count
170!
171! 1253 2013-11-07 10:48:12Z fricke
172! Bugfix: add ref_state to read_parts_of_var_list, otherwise ref_state
173! is zero for initializing_actions = 'cyclic_fill'
174!
175! 1241 2013-10-30 11:36:58Z heinze
176! +nudging
177! +large_scale_forcing
178!
179! 1195 2013-07-01 12:27:57Z heinze
180! Bugfix: allocate ref_state
181!
182! 1179 2013-06-14 05:57:58Z raasch
183! +ref_state
184!
185! 1115 2013-03-26 18:16:16Z hoffmann
186! unused variables removed
187!
188! 1092 2013-02-02 11:24:22Z raasch
189! unused variables removed
190!
191! 1065 2012-11-22 17:42:36Z hoffmann
192! +nc, c_sedimentation, limiter_sedimentation, turbulence
193! -mu_constant, mu_constant_value
194!
195! 1053 2012-11-13 17:11:03Z hoffmann
196! necessary expansions according to the two new prognostic equations (nr, qr)
197! of the two-moment cloud physics scheme:
198! +bc_*_b, +bc_*_t, +bc_*_t_val, *_init, *_surface, *_surface_initial_change,
199! +*_vertical_gradient, +*_vertical_gradient_level, *_vertical_gradient_level_ind,
200! +surface_waterflux_*
201!
202! in addition, steering parameters parameters of the two-moment cloud physics
203! scheme:
204! +cloud_scheme, +drizzle, +mu_constant, +mu_constant_value, +ventilation_effect
205!
206! 1036 2012-10-22 13:43:42Z raasch
207! code put under GPL (PALM 3.9)
208!
209! 1015 2012-09-27 09:23:24Z raasch
210! -adjust_mixing_length
211!
212! 1003 2012-09-14 14:35:53Z raasch
213! -grid_matching
214!
215! 1001 2012-09-13 14:08:46Z raasch
216! -cut_spline_overshoot, dt_fixed, last_dt_change, long_filter_factor,
217! overshoot_limit_*, ups_limit_*
218!
219! 978 2012-08-09 08:28:32Z fricke
220! -km_damp_max, outflow_damping_width
221! +pt_damping_factor, pt_damping_width
222! +z0h_factor
223!
224! 940 2012-07-09 14:31:00Z raasch
225! +neutral
226!
227! 927 2012-06-06 19:15:04Z raasch
228! +masking_method
229!
230! 849 2012-03-15 10:35:09Z raasch
231! first_call_advec_particles renamed first_call_lpm
232!
233! 824 2012-02-17 09:09:57Z raasch
234! +curvature_solution_effects
235!
236! Revision 1.1  1998/03/18 20:18:48  raasch
237! Initial revision
238!
239!
240! Description:
241! ------------
242!> Reading values of global control variables from restart-file (binary format)
243!------------------------------------------------------------------------------!
244 SUBROUTINE read_var_list
245
246
247    USE arrays_3d,                                                             &
248        ONLY:  inflow_damping_factor, mean_inflow_profiles, pt_init,           &
249               q_init, ref_state, s_init, sa_init, u_init, ug, v_init, vg
250
251    USE control_parameters
252
253    USE grid_variables,                                                        &
254        ONLY:  dx, dy
255
256    USE indices,                                                               &
257        ONLY:  nz, nx, nx_on_file, ny, ny_on_file
258
259    USE microphysics_mod,                                                      &
260        ONLY:  c_sedimentation, collision_turbulence,                          &
261               cloud_water_sedimentation, limiter_sedimentation,               &
262               nc_const, ventilation_effect
263
264    USE model_1d_mod,                                                          &
265        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
266
267    USE netcdf_interface,                                                      &
268        ONLY:  netcdf_precision, output_for_t0
269
270    USE particle_attributes,                                                   &
271        ONLY:  curvature_solution_effects
272
273    USE pegrid
274
275    USE radiation_model_mod,                                                   &
276        ONLY:  time_radiation
277
278    USE spectra_mod,                                                           &
279        ONLY:  average_count_sp
280
281    USE statistics,                                                            &
282        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
283               v_max, v_max_ijk, w_max, w_max_ijk
284
285    USE vertical_nesting_mod,                                                  &
286        ONLY:  vnest_init
287
288    IMPLICIT NONE
289
290    CHARACTER (LEN=10) ::  binary_version, version_on_file
291    CHARACTER (LEN=30) ::  variable_chr
292
293
294    CALL check_open( 13 )
295
296!
297!-- Make version number check first
298    READ ( 13 )  version_on_file
299    binary_version = '4.6'
300    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
301       WRITE( message_string, * ) 'version mismatch concerning control ', &
302                                  'variables',                            &
303                                  '&version on file    = "',              &
304                                  TRIM( version_on_file ), '"',           &
305                                  '&version on program = "',              &
306                                  TRIM( binary_version ), '"'
307       CALL message( 'read_var_list', 'PA0296', 1, 2, 0, 6, 0 )
308    ENDIF
309
310!
311!-- Read number of PEs and horizontal index bounds of all PEs used in previous
312!-- run
313    READ ( 13 )  variable_chr
314    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
315       WRITE( message_string, * ) 'numprocs not found in data from prior ', &
316                                  'run on PE ', myid
317       CALL message( 'read_var_list', 'PA0297', 1, 2, 0, 6, 0 )
318    ENDIF
319    READ ( 13 )  numprocs_previous_run
320
321    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
322       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
323    ENDIF
324
325    READ ( 13 )  variable_chr
326    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
327       WRITE( message_string, * ) 'hor_index_bounds not found in data from ', &
328                                  'prior run on PE ', myid
329       CALL message( 'read_var_list', 'PA0298', 1, 2, 0, 6, 0 )
330    ENDIF
331    READ ( 13 )  hor_index_bounds_previous_run
332
333!
334!-- Read vertical number of gridpoints and number of different areas used
335!-- for computing statistics. Allocate arrays depending on these values,
336!-- which are needed for the following read instructions.
337    READ ( 13 )  variable_chr
338    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
339       WRITE( message_string, * ) 'nz not found in data from prior run on PE ',&
340                                  myid
341       CALL message( 'read_var_list', 'PA0299', 1, 2, 0, 6, 0 )
342    ENDIF
343    READ ( 13 )  nz
344
345    READ ( 13 )  variable_chr
346    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
347       WRITE( message_string, * ) 'max_pr_user not found in data from ', &
348                    'prior run on PE ', myid
349       CALL message( 'read_var_list', 'PA0300', 1, 2, 0, 6, 0 )
350    ENDIF
351    READ ( 13 )  max_pr_user    ! This value is checked against the number of
352                                ! user profiles given for the current run
353                                ! in routine user_parin (it has to match)
354
355    READ ( 13 )  variable_chr
356    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
357       WRITE( message_string, * ) 'statistic_regions not found in data from ', &
358                    'prior run on PE ', myid
359       CALL message( 'read_var_list', 'PA0301', 1, 2, 0, 6, 0 )
360    ENDIF
361    READ ( 13 )  statistic_regions
362    IF ( .NOT. ALLOCATED( ug ) )  THEN
363       ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),                       &
364                 v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),              &
365                 ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),           &
366                 hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),        &
367                 hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
368    ENDIF
369
370!
371!-- Now read all control parameters:
372!-- Caution: When the following read instructions have been changed, the
373!-- -------  version number stored in the variable binary_version has to be
374!--          increased. The same changes must also be done in write_var_list.
375    READ ( 13 )  variable_chr
376    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
377
378       SELECT CASE ( TRIM( variable_chr ) )
379
380          CASE ( 'advected_distance_x' )
381             READ ( 13 )  advected_distance_x
382          CASE ( 'advected_distance_y' )
383             READ ( 13 )  advected_distance_y
384          CASE ( 'alpha_surface' )
385             READ ( 13 )  alpha_surface
386          CASE ( 'average_count_pr' )
387             READ ( 13 )  average_count_pr
388          CASE ( 'average_count_sp' )
389             READ ( 13 )  average_count_sp
390          CASE ( 'average_count_3d' )
391             READ ( 13 )  average_count_3d
392          CASE ( 'bc_e_b' )
393             READ ( 13 )  bc_e_b
394          CASE ( 'bc_lr' )
395             READ ( 13 )  bc_lr
396          CASE ( 'bc_ns' )
397             READ ( 13 )  bc_ns
398          CASE ( 'bc_p_b' )
399             READ ( 13 )  bc_p_b
400          CASE ( 'bc_p_t' )
401             READ ( 13 )  bc_p_t
402          CASE ( 'bc_pt_b' )
403             READ ( 13 )  bc_pt_b
404          CASE ( 'bc_pt_t' )
405             READ ( 13 )  bc_pt_t
406          CASE ( 'bc_pt_t_val' )
407             READ ( 13 )  bc_pt_t_val
408          CASE ( 'bc_q_b' )
409             READ ( 13 )  bc_q_b
410          CASE ( 'bc_q_t' )
411             READ ( 13 )  bc_q_t
412          CASE ( 'bc_q_t_val' )
413             READ ( 13 )  bc_q_t_val
414          CASE ( 'bc_s_b' )
415             READ ( 13 )  bc_s_b
416          CASE ( 'bc_s_t' )
417             READ ( 13 )  bc_s_t
418          CASE ( 'bc_sa_t' )
419             READ ( 13 )  bc_sa_t
420          CASE ( 'bc_uv_b' )
421             READ ( 13 )  bc_uv_b
422          CASE ( 'bc_uv_t' )
423             READ ( 13 )  bc_uv_t
424          CASE ( 'bottom_salinityflux' )
425             READ ( 13 )  bottom_salinityflux
426          CASE ( 'building_height' )
427             READ ( 13 )  building_height
428          CASE ( 'building_length_x' )
429             READ ( 13 )  building_length_x
430          CASE ( 'building_length_y' )
431             READ ( 13 )  building_length_y
432          CASE ( 'building_wall_left' )
433             READ ( 13 )  building_wall_left
434          CASE ( 'building_wall_south' )
435             READ ( 13 )  building_wall_south
436          CASE ( 'call_psolver_at_all_substeps' )
437             READ ( 13 )  call_psolver_at_all_substeps
438          CASE ( 'canyon_height' )
439             READ ( 13 )  canyon_height
440          CASE ( 'canyon_width_x' )
441             READ ( 13 )  canyon_width_x
442          CASE ( 'canyon_width_y' )
443             READ ( 13 )  canyon_width_y
444          CASE ( 'canyon_wall_left' )
445             READ ( 13 )  canyon_wall_left
446          CASE ( 'canyon_wall_south' )
447             READ ( 13 )  canyon_wall_south
448          CASE ( 'c_sedimentation' )
449             READ ( 13 )  c_sedimentation
450          CASE ( 'cfl_factor' )
451             READ ( 13 )  cfl_factor
452          CASE ( 'cloud_droplets' )
453             READ ( 13 )  cloud_droplets
454          CASE ( 'cloud_physics' )
455             READ ( 13 )  cloud_physics
456          CASE ( 'cloud_scheme' )
457             READ ( 13 )  cloud_scheme
458          CASE ( 'collective_wait' )
459             READ ( 13 )  collective_wait
460          CASE ( 'conserve_volume_flow' )
461             READ ( 13 )  conserve_volume_flow
462          CASE ( 'conserve_volume_flow_mode' )
463             READ ( 13 )  conserve_volume_flow_mode
464          CASE ( 'constant_flux_layer' )
465             READ ( 13 )  constant_flux_layer
466          CASE ( 'coupling_start_time' )
467             READ ( 13 )  coupling_start_time
468          CASE ( 'current_timestep_number' )
469             READ ( 13 )  current_timestep_number
470          CASE ( 'curvature_solution_effects' )
471             READ ( 13 )  curvature_solution_effects
472          CASE ( 'cycle_mg' )
473             READ ( 13 )  cycle_mg
474          CASE ( 'damp_level_1d' )
475             READ ( 13 )  damp_level_1d
476          CASE ( 'dissipation_1d' )
477             READ ( 13 )  dissipation_1d
478          CASE ( 'do2d_xy_time_count' )
479             READ ( 13 )  do2d_xy_time_count
480          CASE ( 'do2d_xz_time_count' )
481             READ ( 13 )  do2d_xz_time_count
482          CASE ( 'do2d_yz_time_count' )
483             READ ( 13 )  do2d_yz_time_count
484          CASE ( 'do3d_time_count' )
485             READ ( 13 )  do3d_time_count
486          CASE ( 'dp_external' )
487             READ ( 13 )  dp_external
488          CASE ( 'dp_level_b' )
489             READ ( 13 )  dp_level_b
490          CASE ( 'dp_smooth' )
491             READ ( 13 )  dp_smooth
492          CASE ( 'dpdxy' )
493             READ ( 13 )  dpdxy
494          CASE ( 'cloud_water_sedimentation' )
495             READ ( 13 )  cloud_water_sedimentation
496          CASE ( 'dt_pr_1d' )
497             READ ( 13 )  dt_pr_1d
498          CASE ( 'dt_run_control_1d' )
499             READ ( 13 )  dt_run_control_1d
500          CASE ( 'dt_3d' )
501             READ ( 13 )  dt_3d
502          CASE ( 'dvrp_filecount' )
503             READ ( 13 )  dvrp_filecount
504          CASE ( 'dx' )
505             READ ( 13 )  dx
506          CASE ( 'dy' )
507             READ ( 13 )  dy
508          CASE ( 'dz' )
509             READ ( 13 )  dz
510          CASE ( 'dz_max' )
511             READ ( 13 )  dz_max
512          CASE ( 'dz_stretch_factor' )
513             READ ( 13 )  dz_stretch_factor
514          CASE ( 'dz_stretch_level' )
515             READ ( 13 )  dz_stretch_level
516          CASE ( 'e_min' )
517             READ ( 13 )  e_min
518          CASE ( 'end_time_1d' )
519             READ ( 13 )  end_time_1d
520          CASE ( 'fft_method' )
521             READ ( 13 )  fft_method
522          CASE ( 'first_call_lpm' )
523             READ ( 13 )  first_call_lpm
524          CASE ( 'galilei_transformation' )
525             READ ( 13 )  galilei_transformation
526          CASE ( 'hom' )
527             READ ( 13 )  hom
528          CASE ( 'hom_sum' )
529             READ ( 13 )  hom_sum
530          CASE ( 'humidity' )
531             READ ( 13 )  humidity
532          CASE ( 'inflow_damping_factor' )
533             IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
534                ALLOCATE( inflow_damping_factor(0:nz+1) )
535             ENDIF
536             READ ( 13 )  inflow_damping_factor
537          CASE ( 'inflow_damping_height' )
538             READ ( 13 )  inflow_damping_height
539          CASE ( 'inflow_damping_width' )
540             READ ( 13 )  inflow_damping_width
541          CASE ( 'inflow_disturbance_begin' )
542             READ ( 13 )  inflow_disturbance_begin
543          CASE ( 'inflow_disturbance_end' )
544             READ ( 13 )  inflow_disturbance_end
545          CASE ( 'km_constant' )
546             READ ( 13 )  km_constant
547          CASE ( 'large_scale_forcing' )
548             READ ( 13 )  large_scale_forcing
549          CASE ( 'large_scale_subsidence' )
550             READ ( 13 )  large_scale_subsidence
551          CASE ( 'limiter_sedimentation' )
552             READ ( 13 )  limiter_sedimentation
553          CASE ( 'loop_optimization' )
554             READ ( 13 )  loop_optimization
555          CASE ( 'masking_method' )
556             READ ( 13 )  masking_method
557          CASE ( 'mean_inflow_profiles' )
558             IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
559                ALLOCATE( mean_inflow_profiles(0:nz+1,7) )
560             ENDIF
561             READ ( 13 )  mean_inflow_profiles
562          CASE ( 'mg_cycles' )
563             READ ( 13 )  mg_cycles
564          CASE ( 'mg_switch_to_pe0_level' )
565             READ ( 13 )  mg_switch_to_pe0_level
566          CASE ( 'mixing_length_1d' )
567             READ ( 13 )  mixing_length_1d
568          CASE ( 'momentum_advec' )
569             READ ( 13 )  momentum_advec
570          CASE ( 'most_method' )
571             READ ( 13 )  most_method
572          CASE ( 'nc_const' )
573             READ ( 13 )  nc_const
574          CASE ( 'netcdf_precision' )
575             READ ( 13 )  netcdf_precision
576          CASE ( 'neutral' )
577             READ ( 13 )  neutral
578          CASE ( 'ngsrb' )
579             READ ( 13 )  ngsrb
580          CASE ( 'nsor' )
581             READ ( 13 )  nsor
582          CASE ( 'nsor_ini' )
583             READ ( 13 )  nsor_ini
584          CASE ( 'nudging' )
585             READ ( 13 )  nudging
586          CASE ( 'num_leg' )
587             READ ( 13 )  num_leg
588          CASE ( 'nx' )
589             READ ( 13 )  nx
590             nx_on_file = nx
591          CASE ( 'ny' )
592             READ ( 13 )  ny
593             ny_on_file = ny
594          CASE ( 'ocean' )
595             READ ( 13 )  ocean
596          CASE ( 'old_dt' )
597             READ ( 13 )  old_dt
598          CASE ( 'omega' )
599             READ ( 13 )  omega
600          CASE ( 'omega_sor' )
601             READ ( 13 )  omega_sor
602          CASE ( 'output_for_t0' )
603             READ (13)    output_for_t0
604          CASE ( 'passive_scalar' )
605             READ ( 13 )  passive_scalar
606          CASE ( 'latitude' )
607             READ ( 13 )  latitude
608          CASE ( 'longitude' )
609             READ ( 13 )  longitude
610          CASE ( 'prandtl_number' )
611             READ ( 13 )  prandtl_number
612          CASE ( 'precipitation' )
613             READ ( 13 ) precipitation
614          CASE ( 'psolver' )
615             READ ( 13 )  psolver
616          CASE ( 'pt_damping_factor' )
617             READ ( 13 )  pt_damping_factor
618          CASE ( 'pt_damping_width' )
619             READ ( 13 )  pt_damping_width
620          CASE ( 'pt_init' )
621             READ ( 13 )  pt_init
622          CASE ( 'pt_reference' )
623             READ ( 13 )  pt_reference
624          CASE ( 'pt_surface' )
625             READ ( 13 )  pt_surface
626          CASE ( 'pt_surface_initial_change' )
627             READ ( 13 )  pt_surface_initial_change
628          CASE ( 'pt_vertical_gradient' )
629             READ ( 13 )  pt_vertical_gradient
630          CASE ( 'pt_vertical_gradient_level' )
631             READ ( 13 )  pt_vertical_gradient_level
632          CASE ( 'pt_vertical_gradient_level_ind' )
633             READ ( 13 )  pt_vertical_gradient_level_ind
634          CASE ( 'q_init' )
635             READ ( 13 )  q_init
636          CASE ( 'q_surface' )
637             READ ( 13 )  q_surface
638          CASE ( 'q_surface_initial_change' )
639             READ ( 13 )  q_surface_initial_change
640          CASE ( 'q_vertical_gradient' )
641             READ ( 13 )  q_vertical_gradient
642          CASE ( 'q_vertical_gradient_level' )
643             READ ( 13 )  q_vertical_gradient_level
644          CASE ( 'q_vertical_gradient_level_ind' )
645             READ ( 13 )  q_vertical_gradient_level_ind
646          CASE ( 'cloud_top_radiation' )
647             READ ( 13 )  cloud_top_radiation
648          CASE ( 'random_generator' )
649             READ ( 13 )  random_generator
650          CASE ( 'random_heatflux' )
651             READ ( 13 )  random_heatflux
652          CASE ( 'rans_mode' )
653             READ ( 13 )  rans_mode
654          CASE ( 'rayleigh_damping_factor' )
655             READ ( 13 )  rayleigh_damping_factor
656          CASE ( 'rayleigh_damping_height' )
657             READ ( 13 )  rayleigh_damping_height
658          CASE ( 'recycling_width' )
659             READ ( 13 )  recycling_width
660          CASE ( 'recycling_yshift' )
661             READ ( 13 ) recycling_yshift
662          CASE ( 'reference_state' )
663             READ ( 13 )  reference_state
664          CASE ( 'ref_state' )
665             READ ( 13 )  ref_state
666          CASE ( 'residual_limit' )
667             READ ( 13 )  residual_limit
668          CASE ( 'roughness_length' )
669             READ ( 13 )  roughness_length
670          CASE ( 'runnr' )
671             READ ( 13 )  runnr
672          CASE ( 'run_coupled' )
673             READ ( 13 )  run_coupled
674          CASE ( 's_init' )
675             READ ( 13 )  s_init
676          CASE ( 's_surface' )
677             READ ( 13 )  s_surface
678          CASE ( 's_surface_initial_change' )
679             READ ( 13 )  s_surface_initial_change
680          CASE ( 's_vertical_gradient' )
681             READ ( 13 )  s_vertical_gradient
682          CASE ( 's_vertical_gradient_level' )
683             READ ( 13 )  s_vertical_gradient_level
684          CASE ( 's_vertical_gradient_level_ind' )
685             READ ( 13 )  s_vertical_gradient_level_ind
686          CASE ( 'sa_init' )
687             READ ( 13 )  sa_init
688          CASE ( 'sa_surface' )
689             READ ( 13 )  sa_surface
690          CASE ( 'sa_vertical_gradient' )
691             READ ( 13 )  sa_vertical_gradient
692          CASE ( 'sa_vertical_gradient_level' )
693             READ ( 13 )  sa_vertical_gradient_level
694          CASE ( 'scalar_advec' )
695             READ ( 13 )  scalar_advec
696          CASE ( 'simulated_time' )
697             READ ( 13 )  simulated_time
698          CASE ( 'spinup_time' ) 
699             READ ( 13 )  spinup_time
700          CASE ( 'surface_heatflux' )
701             READ ( 13 )  surface_heatflux
702          CASE ( 'surface_pressure' )
703             READ ( 13 )  surface_pressure
704          CASE ( 'surface_scalarflux' )
705             READ ( 13 )  surface_scalarflux
706          CASE ( 'surface_waterflux' )
707             READ ( 13 )  surface_waterflux
708          CASE ( 'time_coupling' )
709             READ ( 13 )  time_coupling
710          CASE ( 'time_disturb' )
711             READ ( 13 )  time_disturb
712          CASE ( 'time_dopr' )
713             READ ( 13 )  time_dopr
714          CASE ( 'time_domask' )
715             READ ( 13 )  time_domask
716          CASE ( 'time_dopr_av' )
717             READ ( 13 )  time_dopr_av
718          CASE ( 'time_dopr_listing' )
719             READ ( 13 )  time_dopr_listing
720          CASE ( 'time_dopts' )
721             READ ( 13 )  time_dopts
722          CASE ( 'time_dosp' )
723             READ ( 13 )  time_dosp
724          CASE ( 'time_dots' )
725             READ ( 13 )  time_dots
726          CASE ( 'time_do2d_xy' )
727             READ ( 13 )  time_do2d_xy
728          CASE ( 'time_do2d_xz' )
729             READ ( 13 )  time_do2d_xz
730          CASE ( 'time_do2d_yz' )
731             READ ( 13 )  time_do2d_yz
732          CASE ( 'time_do3d' )
733             READ ( 13 )  time_do3d
734          CASE ( 'time_do_av' )
735             READ ( 13 )  time_do_av
736          CASE ( 'time_do_sla' )
737             READ ( 13 )  time_do_sla
738          CASE ( 'time_dvrp' )
739             READ ( 13 )  time_dvrp
740          CASE ( 'time_radiation' )
741             READ ( 13 )  time_radiation
742          CASE ( 'time_restart' )
743             READ ( 13 )  time_restart
744          CASE ( 'time_run_control' )
745             READ ( 13 )  time_run_control
746          CASE ( 'time_since_reference_point' )
747             READ ( 13 )  time_since_reference_point
748          CASE ( 'timestep_scheme' )
749             READ ( 13 )  timestep_scheme
750          CASE ( 'topography' )
751             READ ( 13 )  topography
752          CASE ( 'topography_grid_convention' )
753             READ ( 13 )  topography_grid_convention
754          CASE ( 'top_heatflux' )
755             READ ( 13 )  top_heatflux
756          CASE ( 'top_momentumflux_u' )
757             READ ( 13 )  top_momentumflux_u
758          CASE ( 'top_momentumflux_v' )
759             READ ( 13 )  top_momentumflux_v
760          CASE ( 'top_salinityflux' )
761             READ ( 13 )  top_salinityflux
762          CASE ( 'top_scalarflux' )
763             READ ( 13 )  top_scalarflux
764          CASE ( 'tsc' )
765             READ ( 13 )  tsc
766          CASE ( 'collision_turbulence' )
767             READ ( 13 )  collision_turbulence
768          CASE ( 'tunnel_height' )
769             READ ( 13 )  tunnel_height
770          CASE ( 'tunnel_length' )
771             READ ( 13 )  tunnel_length
772          CASE ( 'tunnel_width_x' )
773             READ ( 13 )  tunnel_width_x
774          CASE ( 'tunnel_width_y' )
775             READ ( 13 )  tunnel_width_y
776          CASE ( 'tunnel_wall_depth' )
777             READ ( 13 )  tunnel_wall_depth
778          CASE ( 'turbulence_closure' )
779             READ ( 13 )  turbulence_closure
780          CASE ( 'turbulent_inflow' )
781             READ ( 13 )  turbulent_inflow
782          CASE ( 'u_bulk' )
783             READ ( 13 )  u_bulk
784          CASE ( 'u_init' )
785             READ ( 13 )  u_init
786          CASE ( 'u_max' )
787             READ ( 13 )  u_max
788          CASE ( 'u_max_ijk' )
789             READ ( 13 )  u_max_ijk
790          CASE ( 'ug' )
791             READ ( 13 )  ug
792          CASE ( 'ug_surface' )
793             READ ( 13 )  ug_surface
794          CASE ( 'ug_vertical_gradient' )
795             READ ( 13 )  ug_vertical_gradient
796          CASE ( 'ug_vertical_gradient_level' )
797             READ ( 13 )  ug_vertical_gradient_level
798          CASE ( 'ug_vertical_gradient_level_ind' )
799             READ ( 13 )  ug_vertical_gradient_level_ind
800          CASE ( 'use_surface_fluxes' )
801             READ ( 13 )  use_surface_fluxes
802          CASE ( 'use_top_fluxes' )
803             READ ( 13 )  use_top_fluxes
804          CASE ( 'use_ug_for_galilei_tr' )
805             READ ( 13 )  use_ug_for_galilei_tr
806          CASE ( 'use_upstream_for_tke' )
807             READ ( 13 )  use_upstream_for_tke
808          CASE ( 'v_bulk' )
809             READ ( 13 )  v_bulk
810          CASE ( 'v_init' )
811             READ ( 13 )  v_init
812          CASE ( 'v_max' )
813             READ ( 13 )  v_max
814          CASE ( 'v_max_ijk' )
815             READ ( 13 )  v_max_ijk
816          CASE ( 'ventilation_effect' )
817             READ ( 13 )  ventilation_effect
818          CASE ( 'vg' )
819             READ ( 13 )  vg
820          CASE ( 'vg_surface' )
821             READ ( 13 )  vg_surface
822          CASE ( 'vg_vertical_gradient' )
823             READ ( 13 )  vg_vertical_gradient
824          CASE ( 'vg_vertical_gradient_level' )
825             READ ( 13 )  vg_vertical_gradient_level
826          CASE ( 'vg_vertical_gradient_level_ind' )
827             READ ( 13 )  vg_vertical_gradient_level_ind
828          CASE ( 'virtual_flight' )
829             READ ( 13 )  virtual_flight
830          CASE ( 'vnest_init' )
831             READ ( 13 )  vnest_init
832          CASE ( 'volume_flow_area' )
833             READ ( 13 )  volume_flow_area
834          CASE ( 'volume_flow_initial' )
835             READ ( 13 )  volume_flow_initial
836          CASE ( 'wall_adjustment' )
837             READ ( 13 )  wall_adjustment
838          CASE ( 'subs_vertical_gradient' )
839             READ ( 13 )  subs_vertical_gradient
840          CASE ( 'subs_vertical_gradient_level' )
841             READ ( 13 )  subs_vertical_gradient_level
842          CASE ( 'subs_vertical_gradient_level_i' )
843             READ ( 13 )  subs_vertical_gradient_level_i
844          CASE ( 'wall_heatflux' )
845             READ ( 13 )  wall_heatflux
846          CASE ( 'wall_humidityflux' )
847             READ ( 13 )  wall_humidityflux
848          CASE ( 'wall_scalarflux' )
849             READ ( 13 )  wall_scalarflux
850          CASE ( 'wall_salinityflux' )
851             READ ( 13 )  wall_salinityflux
852          CASE ( 'w_max' )
853             READ ( 13 )  w_max
854          CASE ( 'w_max_ijk' )
855             READ ( 13 )  w_max_ijk
856          CASE ( 'y_shift' )
857             READ ( 13 )  y_shift
858          CASE ( 'zeta_max' )
859             READ ( 13 )  zeta_max
860          CASE ( 'zeta_min' )
861             READ ( 13 )  zeta_min
862          CASE ( 'z0h_factor' )
863             READ ( 13 )  z0h_factor
864
865          CASE DEFAULT
866             WRITE( message_string, * ) 'unknown variable named "',         &
867                                        TRIM( variable_chr ), '" found in', &
868                                        ' data from prior run on PE ', myid
869             CALL message( 'read_var_list', 'PA0302', 1, 2, 0, 6, 0 )
870        END SELECT
871!
872!--    Read next string
873       READ ( 13 )  variable_chr
874
875    ENDDO
876
877
878 END SUBROUTINE read_var_list
879
880
881
882!------------------------------------------------------------------------------!
883! Description:
884! ------------
885!> Skipping the global control variables from restart-file (binary format)
886!> except some information needed when reading restart data from a previous
887!> run which used a smaller total domain or/and a different domain decomposition.
888!------------------------------------------------------------------------------!
889
890 SUBROUTINE read_parts_of_var_list
891
892
893    USE arrays_3d,                                                             &
894        ONLY:  inflow_damping_factor, mean_inflow_profiles, ref_state, ug, vg
895
896    USE control_parameters
897
898    USE indices,                                                               &
899        ONLY:  nz, nx, nx_on_file, ny, ny_on_file
900
901    USE kinds
902
903    USE pegrid
904
905    USE statistics,                                                            &
906        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
907               v_max, v_max_ijk, w_max, w_max_ijk
908
909    IMPLICIT NONE
910
911    CHARACTER (LEN=10) ::  version_on_file
912    CHARACTER (LEN=20) ::  momentum_advec_check
913    CHARACTER (LEN=20) ::  scalar_advec_check
914    CHARACTER (LEN=30) ::  variable_chr
915    CHARACTER (LEN=1)  ::  cdum
916
917    INTEGER(iwp) ::  max_pr_user_on_file
918    INTEGER(iwp) ::  nz_on_file
919    INTEGER(iwp) ::  statistic_regions_on_file
920    INTEGER(iwp) ::  tmp_mpru
921    INTEGER(iwp) ::  tmp_sr
922
923    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
924    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
925
926
927    CALL check_open( 13 )
928
929    READ ( 13 )  version_on_file
930
931
932!
933!-- Read number of PEs and horizontal index bounds of all PEs used in previous
934!-- run
935    READ ( 13 )  variable_chr
936    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
937       WRITE( message_string, * ) 'numprocs not found in data from prior ', &
938                                  'run on PE ', myid
939       CALL message( 'read_parts_of_var_list', 'PA0297', 1, 2, 0, 6, 0 )
940    ENDIF
941    READ ( 13 )  numprocs_previous_run
942
943    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
944       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
945    ENDIF
946
947    READ ( 13 )  variable_chr
948    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
949       WRITE( message_string, * ) 'hor_index_bounds not found in data from ', &
950                                  'prior run on PE ', myid
951       CALL message( 'read_parts_of_var_list', 'PA0298', 1, 2, 0, 6, 0 )
952    ENDIF
953    READ ( 13 )  hor_index_bounds_previous_run
954
955!
956!-- Read vertical number of gridpoints and number of different areas used
957!-- for computing statistics. Allocate arrays depending on these values,
958!-- which are needed for the following read instructions.
959    READ ( 13 )  variable_chr
960    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
961       message_string = 'nz not found in restart data file'
962       CALL message( 'read_parts_of_var_list', 'PA0303', 1, 2, 0, 6, 0 )
963    ENDIF
964    READ ( 13 )  nz_on_file
965    IF ( nz_on_file /= nz )  THEN
966       WRITE( message_string, * ) 'mismatch concerning number of ',      &
967                                  'gridpoints along z',                  &
968                                  '&nz on file    = "', nz_on_file, '"', &
969                                  '&nz from run   = "', nz, '"'
970       CALL message( 'read_parts_of_var_list', 'PA0304', 1, 2, 0, 6, 0 )
971    ENDIF
972
973    READ ( 13 )  variable_chr
974    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
975       message_string = 'max_pr_user not found in restart data file'
976       CALL message( 'read_parts_of_var_list', 'PA0305', 1, 2, 0, 6, 0 )
977    ENDIF
978    READ ( 13 )  max_pr_user_on_file
979    IF ( max_pr_user_on_file /= max_pr_user )  THEN
980       WRITE( message_string, * ) 'number of user profiles on res',           &
981                                  'tart data file differs from the current ', &
982                                  'run&max_pr_user on file    = "',           &
983                                  max_pr_user_on_file, '"',                   &
984                                  '&max_pr_user from run   = "',              &
985                                  max_pr_user, '"'
986       CALL message( 'read_parts_of_var_list', 'PA0306', 0, 0, 0, 6, 0 )
987       tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
988    ELSE
989       tmp_mpru = max_pr_user
990    ENDIF
991
992    READ ( 13 )  variable_chr
993    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
994       message_string = 'statistic_regions not found in restart data file'
995       CALL message( 'read_parts_of_var_list', 'PA0307', 1, 2, 0, 6, 0 )
996    ENDIF
997    READ ( 13 )  statistic_regions_on_file
998    IF ( statistic_regions_on_file /= statistic_regions )  THEN
999       WRITE( message_string, * ) 'statistic regions on restart data file ',&
1000                                  'differ from the current run',            &
1001                                  '&statistic regions on file    = "',      &
1002                                  statistic_regions_on_file, '"',           &
1003                                  '&statistic regions from run   = "',      &
1004                                   statistic_regions, '"',                  &
1005                                  '&statistic data may be lost!'
1006       CALL message( 'read_parts_of_var_list', 'PA0308', 0, 1, 0, 6, 0 )
1007       tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
1008    ELSE
1009       tmp_sr = statistic_regions
1010    ENDIF
1011
1012!
1013!-- Now read and check some control parameters and skip the rest
1014    READ ( 13 )  variable_chr
1015
1016    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
1017
1018       SELECT CASE ( TRIM( variable_chr ) )
1019
1020          CASE ( 'average_count_pr' )
1021             READ ( 13 )  average_count_pr
1022             IF ( average_count_pr /= 0 )  THEN
1023                WRITE( message_string, * ) 'inflow profiles not temporally ',  &
1024                               'averaged. &Averaging will be done now using ', &
1025                               average_count_pr, ' samples.'
1026                CALL message( 'read_parts_of_var_list', 'PA0309', &
1027                                                                 0, 1, 0, 6, 0 )
1028             ENDIF
1029
1030          CASE ( 'hom' )
1031             ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file, &
1032                       0:statistic_regions_on_file) )
1033             READ ( 13 )  hom_on_file
1034             hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
1035                          hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
1036             DEALLOCATE( hom_on_file )
1037
1038          CASE ( 'hom_sum' )
1039             ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file, &
1040                       0:statistic_regions_on_file) )
1041             READ ( 13 )  hom_sum_on_file
1042             hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
1043                          hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
1044             DEALLOCATE( hom_sum_on_file )
1045
1046          CASE ( 'momentum_advec' )
1047             momentum_advec_check = momentum_advec
1048             READ ( 13 )  momentum_advec
1049             IF ( TRIM( momentum_advec_check ) /= TRIM( momentum_advec ) )  THEN
1050                WRITE( message_string, * ) 'momentum_advec of the restart run ',&
1051                               'differs from momentum_advec of the initial run.'
1052                CALL message( 'read_parts_of_var_list', 'PA0100', &
1053                                                                 1, 2, 0, 6, 0 )
1054             END IF
1055
1056          CASE ( 'nx' )
1057             READ ( 13 )  nx_on_file
1058
1059          CASE ( 'ny' )
1060             READ ( 13 )  ny_on_file
1061
1062          CASE ( 'ref_state' )
1063             READ ( 13 )  ref_state
1064
1065          CASE ( 'scalar_advec' )
1066             scalar_advec_check = scalar_advec
1067             READ ( 13 )  scalar_advec
1068             IF ( TRIM( scalar_advec_check ) /= TRIM( scalar_advec ) )  THEN
1069                WRITE( message_string, * ) 'scalar_advec of the restart run ', &
1070                               'differs from scalar_advec of the initial run.'
1071                CALL message( 'read_parts_of_var_list', 'PA0101', &
1072                                                                 1, 2, 0, 6, 0 )
1073             END IF
1074
1075          CASE DEFAULT
1076
1077             READ ( 13 )  cdum
1078
1079       END SELECT
1080
1081       READ ( 13 )  variable_chr
1082
1083    ENDDO
1084
1085!
1086!-- Calculate the temporal average of vertical profiles, if neccessary
1087    IF ( average_count_pr /= 0 )  THEN
1088       hom_sum = hom_sum / REAL( average_count_pr, KIND=wp )
1089    ENDIF
1090
1091
1092 END SUBROUTINE read_parts_of_var_list
1093
1094
1095
1096!------------------------------------------------------------------------------!
1097! Description:
1098! ------------
1099!> Skipping the global control variables from restart-file (binary format)
1100!------------------------------------------------------------------------------!
1101
1102 SUBROUTINE skip_var_list
1103
1104    USE control_parameters,                                                    &
1105        ONLY: wind_turbine, wind_turbine_prerun, virtual_flight,               & 
1106              virtual_flight_prerun, syn_turb_gen, syn_turb_gen_prerun
1107
1108    USE wind_turbine_model_mod,                                                &
1109        ONLY: wtm_skip_var_list
1110
1111    USE flight_mod,                                                            &
1112        ONLY: flight_skip_var_list
1113
1114    USE synthetic_turbulence_generator_mod,                                    &
1115        ONLY: stg_skip_var_list
1116
1117
1118    IMPLICIT NONE
1119
1120    CHARACTER (LEN=10) ::  version_on_file
1121    CHARACTER (LEN=30) ::  variable_chr
1122
1123    CHARACTER (LEN=1) ::  cdum
1124
1125
1126    READ ( 13 )  version_on_file
1127
1128    READ ( 13 )  variable_chr
1129
1130    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
1131
1132       READ ( 13 )  cdum
1133       READ ( 13 )  variable_chr
1134
1135    ENDDO
1136
1137!
1138!-- In case of virtual flights, skip also variables related to
1139!-- this module.
1140    IF ( wind_turbine_prerun )  CALL wtm_skip_var_list
1141
1142!
1143!-- In case of virtual flights, skip also variables related to
1144!-- this module.
1145    IF ( virtual_flight_prerun)  CALL flight_skip_var_list
1146
1147!
1148!-- In case of virtual flights, skip also variables related to
1149!-- this module.
1150    IF ( syn_turb_gen_prerun )  CALL stg_skip_var_list
1151
1152
1153 END SUBROUTINE skip_var_list
Note: See TracBrowser for help on using the repository browser.