source: palm/tags/release-5.0/SOURCE/read_var_list.f90 @ 4383

Last change on this file since 4383 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

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