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

Last change on this file since 1523 was 1523, checked in by keck, 9 years ago

last commit documented

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