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

Last change on this file since 1616 was 1616, checked in by suehring, 9 years ago

last commit documented

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