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

Last change on this file since 2257 was 2233, checked in by suehring, 7 years ago

last commit documented

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