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

Last change on this file since 1612 was 1586, checked in by maronga, 9 years ago

last commit documented

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