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

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

Added support for RRTMG radiation code

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