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

Last change on this file since 410 was 392, checked in by raasch, 15 years ago

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:


lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:


Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

advec_particles, check_parameters, cpu_log, data_output_2d, data_output_3d, header, init_3d_model, init_particles, init_ocean, modules, netcdf, prandtl_fluxes, production_e, read_var_list, time_integration, user_last_actions, write_var_list

  • Property svn:keywords set to Id
File size: 30.4 KB
Line 
1 SUBROUTINE read_var_list
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: read_var_list.f90 392 2009-09-24 10:39:14Z letzel $
11!
12! 345 2009-07-01 14:37:56Z heinze
13! +output_for_t0
14! dt_fixed is read into a dummy variable.
15! Output of messages replaced by message handling routine.
16! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
17! canyon_wall_south, conserve_volume_flow_mode, coupling_start_time,
18! dp_external, dp_level_b, dp_smooth, dpdxy, run_coupled,
19! time_since_reference_point, topography_grid_convention, u_bulk, v_bulk
20!
21! 216 2008-11-25 07:12:43Z raasch
22! limitations for nx_on_file, ny_on_file removed (read_parts_of_var_list)
23!
24! 173 2008-05-23 20:39:38Z raasch
25! +cthf, leaf_surface_concentration, scalar_exchange_coefficient
26! +numprocs_previous_run, hor_index_bounds_previous_run, inflow_damping_factor,
27! inflow_damping_height, inflow_damping_width, mean_inflow_profiles,
28! recycling_width, turbulent_inflow,
29! -cross_ts_*, npex, npey,
30! hom_sum, volume_flow_area, volume_flow_initial moved from
31! read_3d_binary to here,
32! routines read_parts_of_var_list and skip_var_list added at the end
33!
34! 138 2007-11-28 10:03:58Z letzel
35! +canopy_mode, drag_coefficient, lad, lad_surface, lad_vertical_gradient,
36! lad_vertical_gradient_level, lad_vertical_gradient_level_ind, pch_index,
37! plant_canopy, time_sort_particles
38!
39! 102 2007-07-27 09:09:17Z raasch
40! +time_coupling, top_momentumflux_u|v
41!
42! 95 2007-06-02 16:48:38Z raasch
43! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,
44! sa_vertical_gradient_level, bottom/top_salinity_flux
45!
46! 87 2007-05-22 15:46:47Z raasch
47! +max_pr_user (version 3.1), var_hom renamed pr_palm
48!
49! 75 2007-03-22 09:54:05Z raasch
50! +loop_optimization, pt_reference, moisture renamed humidity
51!
52! 20 2007-02-26 00:12:32Z raasch
53! +top_heatflux, use_top_fluxes
54!
55! RCS Log replace by Id keyword, revision history cleaned up
56!
57! Revision 1.34  2006/08/22 14:14:27  raasch
58! +dz_max
59!
60! Revision 1.1  1998/03/18 20:18:48  raasch
61! Initial revision
62!
63!
64! Description:
65! ------------
66! Reading values of global control variables from restart-file (binary format)
67!------------------------------------------------------------------------------!
68
69    USE arrays_3d
70    USE averaging
71    USE control_parameters
72    USE grid_variables
73    USE indices
74    USE model_1d
75    USE netcdf_control
76    USE particle_attributes
77    USE pegrid
78    USE profil_parameter
79    USE statistics
80
81    IMPLICIT NONE
82
83    CHARACTER (LEN=10) ::  binary_version, version_on_file
84    CHARACTER (LEN=30) ::  variable_chr
85
86    LOGICAL ::  ldum
87
88
89    CALL check_open( 13 )
90
91!
92!-- Make version number check first
93    READ ( 13 )  version_on_file
94    binary_version = '3.4'
95    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
96       WRITE( message_string, * ) 'version mismatch concerning control ', &
97                                  'variables',                            &
98                                  '&version on file    = "',              &
99                                  TRIM( version_on_file ), '"',           &
100                                  '&version on program = "',              &
101                                  TRIM( binary_version ), '"'
102       CALL message( 'read_var_list', 'PA0296', 1, 2, 0, 6, 0 )
103    ENDIF
104
105!
106!-- Read number of PEs and horizontal index bounds of all PEs used in previous
107!-- run
108    READ ( 13 )  variable_chr
109    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
110       WRITE( message_string, * ) 'numprocs not found in data from prior ', &
111                                  'run on PE ', myid
112       CALL message( 'read_var_list', 'PA0297', 1, 2, 0, 6, 0 )
113    ENDIF
114    READ ( 13 )  numprocs_previous_run
115
116    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
117       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
118    ENDIF
119
120    READ ( 13 )  variable_chr
121    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
122       WRITE( message_string, * ) 'hor_index_bounds not found in data from ', &
123                                  'prior run on PE ', myid
124       CALL message( 'read_var_list', 'PA0298', 1, 2, 0, 6, 0 )
125    ENDIF
126    READ ( 13 )  hor_index_bounds_previous_run
127
128!
129!-- Read vertical number of gridpoints and number of different areas used
130!-- for computing statistics. Allocate arrays depending on these values,
131!-- which are needed for the following read instructions.
132    READ ( 13 )  variable_chr
133    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
134       WRITE( message_string, * ) 'nz not found in data from prior run on PE ',&
135                                  myid
136       CALL message( 'read_var_list', 'PA0299', 1, 2, 0, 6, 0 )
137    ENDIF
138    READ ( 13 )  nz
139
140    READ ( 13 )  variable_chr
141    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
142       WRITE( message_string, * ) 'max_pr_user not found in data from ', &
143                    'prior run on PE ', myid
144       CALL message( 'read_var_list', 'PA0300', 1, 2, 0, 6, 0 )
145    ENDIF
146    READ ( 13 )  max_pr_user    ! This value is checked against the number of
147                                ! user profiles given for the current run
148                                ! in routine user_parin (it has to match)
149
150    READ ( 13 )  variable_chr
151    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
152       WRITE( message_string, * ) 'statistic_regions not found in data from ', &
153                    'prior run on PE ', myid
154       CALL message( 'read_var_list', 'PA0301', 1, 2, 0, 6, 0 )
155    ENDIF
156    READ ( 13 )  statistic_regions
157    IF ( .NOT. ALLOCATED( ug ) )  THEN
158       ALLOCATE( lad(0:nz+1), ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),    &
159                 v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),        &
160                 sa_init(0:nz+1),                                        &
161                 hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),  &
162                 hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
163    ENDIF
164
165!
166!-- Now read all control parameters:
167!-- Caution: When the following read instructions have been changed, the
168!-- -------  version number stored in the variable binary_version has to be
169!--          increased. The same changes must also be done in write_var_list.
170    READ ( 13 )  variable_chr
171    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
172
173       SELECT CASE ( TRIM( variable_chr ) )
174
175          CASE ( 'adjust_mixing_length' )
176             READ ( 13 )  adjust_mixing_length
177          CASE ( 'advected_distance_x' )
178             READ ( 13 )  advected_distance_x
179          CASE ( 'advected_distance_y' )
180             READ ( 13 )  advected_distance_y
181          CASE ( 'alpha_surface' )
182             READ ( 13 )  alpha_surface
183          CASE ( 'average_count_pr' )
184             READ ( 13 )  average_count_pr
185          CASE ( 'average_count_sp' )
186             READ ( 13 )  average_count_sp
187          CASE ( 'average_count_3d' )
188             READ ( 13 )  average_count_3d
189          CASE ( 'bc_e_b' )
190             READ ( 13 )  bc_e_b
191          CASE ( 'bc_lr' )
192             READ ( 13 )  bc_lr
193          CASE ( 'bc_ns' )
194             READ ( 13 )  bc_ns
195          CASE ( 'bc_p_b' )
196             READ ( 13 )  bc_p_b
197          CASE ( 'bc_p_t' )
198             READ ( 13 )  bc_p_t
199          CASE ( 'bc_pt_b' )
200             READ ( 13 )  bc_pt_b
201          CASE ( 'bc_pt_t' )
202             READ ( 13 )  bc_pt_t
203          CASE ( 'bc_pt_t_val' )
204             READ ( 13 )  bc_pt_t_val
205          CASE ( 'bc_q_b' )
206             READ ( 13 )  bc_q_b
207          CASE ( 'bc_q_t' )
208             READ ( 13 )  bc_q_t
209          CASE ( 'bc_q_t_val' )
210             READ ( 13 )  bc_q_t_val
211          CASE ( 'bc_s_b' )
212             READ ( 13 )  bc_s_b
213          CASE ( 'bc_s_t' )
214             READ ( 13 )  bc_s_t
215          CASE ( 'bc_sa_t' )
216             READ ( 13 )  bc_sa_t
217          CASE ( 'bc_uv_b' )
218             READ ( 13 )  bc_uv_b
219          CASE ( 'bc_uv_t' )
220             READ ( 13 )  bc_uv_t
221          CASE ( 'bottom_salinityflux' )
222             READ ( 13 )  bottom_salinityflux
223          CASE ( 'building_height' )
224             READ ( 13 )  building_height
225          CASE ( 'building_length_x' )
226             READ ( 13 )  building_length_x
227          CASE ( 'building_length_y' )
228             READ ( 13 )  building_length_y
229          CASE ( 'building_wall_left' )
230             READ ( 13 )  building_wall_left
231          CASE ( 'building_wall_south' )
232             READ ( 13 )  building_wall_south
233          CASE ( 'canopy_mode' )
234             READ ( 13 )  canopy_mode
235          CASE ( 'canyon_height' )
236             READ ( 13 )  canyon_height
237          CASE ( 'canyon_width_x' )
238             READ ( 13 )  canyon_width_x
239          CASE ( 'canyon_width_y' )
240             READ ( 13 )  canyon_width_y
241          CASE ( 'canyon_wall_left' )
242             READ ( 13 )  canyon_wall_left
243          CASE ( 'canyon_wall_south' )
244             READ ( 13 )  canyon_wall_south
245          CASE ( 'cloud_droplets' )
246             READ ( 13 )  cloud_droplets
247          CASE ( 'cloud_physics' )
248             READ ( 13 )  cloud_physics
249          CASE ( 'conserve_volume_flow' )
250             READ ( 13 )  conserve_volume_flow
251          CASE ( 'conserve_volume_flow_mode' )
252             READ ( 13 )  conserve_volume_flow_mode
253          CASE ( 'coupling_start_time' )
254             READ ( 13 )  coupling_start_time
255          CASE ( 'cthf' )
256             READ ( 13 )  cthf
257          CASE ( 'current_timestep_number' )
258             READ ( 13 )  current_timestep_number
259          CASE ( 'cut_spline_overshoot' )
260             READ ( 13 )  cut_spline_overshoot
261          CASE ( 'damp_level_1d' )
262             READ ( 13 )  damp_level_1d
263          CASE ( 'dissipation_1d' )
264             READ ( 13 )  dissipation_1d
265          CASE ( 'dp_external' )
266             READ ( 13 )  dp_external
267          CASE ( 'dp_level_b' )
268             READ ( 13 )  dp_level_b
269          CASE ( 'dp_smooth' )
270             READ ( 13 )  dp_smooth
271          CASE ( 'dpdxy' )
272             READ ( 13 )  dpdxy
273          CASE ( 'drag_coefficient' )
274             READ ( 13 )  drag_coefficient
275          CASE ( 'dt_fixed' )
276             READ ( 13 )  ldum   ! restart files created before rev 333
277                                 ! contained dt_fixed by mistake; it is still
278                                 ! read here in order to allow usage of these
279                                 ! older restart files; can be removed in a
280                                 ! later version
281          CASE ( 'dt_pr_1d' )
282             READ ( 13 )  dt_pr_1d
283          CASE ( 'dt_run_control_1d' )
284             READ ( 13 )  dt_run_control_1d
285          CASE ( 'dt_3d' )
286             READ ( 13 )  dt_3d
287          CASE ( 'dvrp_filecount' )
288             READ ( 13 )  dvrp_filecount
289          CASE ( 'dx' )
290             READ ( 13 )  dx
291          CASE ( 'dy' )
292             READ ( 13 )  dy
293          CASE ( 'dz' )
294             READ ( 13 )  dz
295          CASE ( 'dz_max' )
296             READ ( 13 )  dz_max
297          CASE ( 'dz_stretch_factor' )
298             READ ( 13 )  dz_stretch_factor
299          CASE ( 'dz_stretch_level' )
300             READ ( 13 )  dz_stretch_level
301          CASE ( 'e_min' )
302             READ ( 13 )  e_min
303          CASE ( 'end_time_1d' )
304             READ ( 13 )  end_time_1d
305          CASE ( 'fft_method' )
306             READ ( 13 )  fft_method
307          CASE ( 'first_call_advec_particles' )
308             READ ( 13 )  first_call_advec_particles
309          CASE ( 'galilei_transformation' )
310             READ ( 13 )  galilei_transformation
311          CASE ( 'grid_matching' )
312             READ ( 13 )  grid_matching
313          CASE ( 'hom' )
314             READ ( 13 )  hom
315          CASE ( 'hom_sum' )
316             READ ( 13 )  hom_sum
317          CASE ( 'humidity' )
318             READ ( 13 )  humidity
319          CASE ( 'inflow_damping_factor' )
320             IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
321                ALLOCATE( inflow_damping_factor(0:nz+1) )
322             ENDIF
323             READ ( 13 )  inflow_damping_factor
324          CASE ( 'inflow_damping_height' )
325             READ ( 13 )  inflow_damping_height
326          CASE ( 'inflow_damping_width' )
327             READ ( 13 )  inflow_damping_width
328          CASE ( 'inflow_disturbance_begin' )
329             READ ( 13 )  inflow_disturbance_begin
330          CASE ( 'inflow_disturbance_end' )
331             READ ( 13 )  inflow_disturbance_end
332          CASE ( 'km_constant' )
333             READ ( 13 )  km_constant
334          CASE ( 'km_damp_max' )
335             READ ( 13 )  km_damp_max
336          CASE ( 'lad' )
337             READ ( 13 )  lad
338          CASE ( 'lad_surface' )
339             READ ( 13 )  lad_surface
340          CASE ( 'lad_vertical_gradient' )
341             READ ( 13 )  lad_vertical_gradient
342          CASE ( 'lad_vertical_gradient_level' )
343             READ ( 13 )  lad_vertical_gradient_level
344          CASE ( 'lad_vertical_gradient_level_in' )
345             READ ( 13 )  lad_vertical_gradient_level_ind
346          CASE ( 'last_dt_change' )
347             READ ( 13 )  last_dt_change
348          CASE ( 'leaf_surface_concentration' )
349             READ ( 13 )  leaf_surface_concentration
350          CASE ( 'long_filter_factor' )
351             READ ( 13 )  long_filter_factor
352          CASE ( 'loop_optimization' )
353             READ ( 13 )  loop_optimization
354          CASE ( 'mean_inflow_profiles' )
355             IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
356                ALLOCATE( mean_inflow_profiles(0:nz+1,5) )
357             ENDIF
358             READ ( 13 )  mean_inflow_profiles
359          CASE ( 'mixing_length_1d' )
360             READ ( 13 )  mixing_length_1d
361          CASE ( 'momentum_advec' )
362             READ ( 13 )  momentum_advec
363          CASE ( 'netcdf_precision' )
364             READ ( 13 )  netcdf_precision
365          CASE ( 'nsor_ini' )
366             READ ( 13 )  nsor_ini
367          CASE ( 'nx' )
368             READ ( 13 )  nx
369             nx_on_file = nx
370          CASE ( 'ny' )
371             READ ( 13 )  ny
372             ny_on_file = ny
373          CASE ( 'ocean' )
374             READ ( 13 )  ocean
375          CASE ( 'old_dt' )
376             READ ( 13 )  old_dt
377          CASE ( 'omega' )
378             READ ( 13 )  omega
379          CASE ( 'outflow_damping_width' )
380             READ ( 13 )  outflow_damping_width
381          CASE ( 'output_for_t0' )
382             READ (13)    output_for_t0
383          CASE ( 'overshoot_limit_e' )
384             READ ( 13 )  overshoot_limit_e
385          CASE ( 'overshoot_limit_pt' )
386             READ ( 13 )  overshoot_limit_pt
387          CASE ( 'overshoot_limit_u' )
388             READ ( 13 )  overshoot_limit_u
389          CASE ( 'overshoot_limit_v' )
390             READ ( 13 )  overshoot_limit_v
391          CASE ( 'overshoot_limit_w' )
392             READ ( 13 )  overshoot_limit_w
393          CASE ( 'passive_scalar' )
394             READ ( 13 )  passive_scalar
395          CASE ( 'pch_index' )
396             READ ( 13 )  pch_index
397          CASE ( 'phi' )
398             READ ( 13 )  phi
399          CASE ( 'plant_canopy' )
400             READ ( 13 )  plant_canopy
401          CASE ( 'prandtl_layer' )
402             READ ( 13 )  prandtl_layer
403          CASE ( 'precipitation' )
404             READ ( 13 ) precipitation
405          CASE ( 'pt_init' )
406             READ ( 13 )  pt_init
407          CASE ( 'pt_reference' )
408             READ ( 13 )  pt_reference
409          CASE ( 'pt_surface' )
410             READ ( 13 )  pt_surface
411          CASE ( 'pt_surface_initial_change' )
412             READ ( 13 )  pt_surface_initial_change
413          CASE ( 'pt_vertical_gradient' )
414             READ ( 13 )  pt_vertical_gradient
415          CASE ( 'pt_vertical_gradient_level' )
416             READ ( 13 )  pt_vertical_gradient_level
417          CASE ( 'pt_vertical_gradient_level_ind' )
418             READ ( 13 )  pt_vertical_gradient_level_ind
419          CASE ( 'q_init' )
420             READ ( 13 )  q_init
421          CASE ( 'q_surface' )
422             READ ( 13 )  q_surface
423          CASE ( 'q_surface_initial_change' )
424             READ ( 13 )  q_surface_initial_change
425          CASE ( 'q_vertical_gradient' )
426             READ ( 13 )  q_vertical_gradient
427          CASE ( 'q_vertical_gradient_level' )
428             READ ( 13 )  q_vertical_gradient_level
429          CASE ( 'q_vertical_gradient_level_ind' )
430             READ ( 13 )  q_vertical_gradient_level_ind
431          CASE ( 'radiation' )
432             READ ( 13 )  radiation
433          CASE ( 'random_generator' )
434             READ ( 13 )  random_generator
435          CASE ( 'random_heatflux' )
436             READ ( 13 )  random_heatflux
437          CASE ( 'recycling_width' )
438             READ ( 13 )  recycling_width
439          CASE ( 'rif_max' )
440             READ ( 13 )  rif_max
441          CASE ( 'rif_min' )
442             READ ( 13 )  rif_min
443          CASE ( 'roughness_length' )
444             READ ( 13 )  roughness_length
445          CASE ( 'runnr' )
446             READ ( 13 )  runnr
447          CASE ( 'run_coupled' )
448             READ ( 13 )  run_coupled
449          CASE ( 'sa_init' )
450             READ ( 13 )  sa_init
451          CASE ( 'sa_surface' )
452             READ ( 13 )  sa_surface
453          CASE ( 'sa_vertical_gradient' )
454             READ ( 13 )  sa_vertical_gradient
455          CASE ( 'sa_vertical_gradient_level' )
456             READ ( 13 )  sa_vertical_gradient_level
457          CASE ( 'scalar_advec' )
458             READ ( 13 )  scalar_advec
459          CASE ( 'scalar_exchange_coefficient' )
460             READ ( 13 )  scalar_exchange_coefficient
461          CASE ( 'simulated_time' )
462             READ ( 13 )  simulated_time
463          CASE ( 'surface_heatflux' )
464             READ ( 13 )  surface_heatflux
465          CASE ( 'surface_pressure' )
466             READ ( 13 )  surface_pressure
467          CASE ( 'surface_scalarflux' )
468             READ ( 13 )  surface_scalarflux             
469          CASE ( 'surface_waterflux' )
470             READ ( 13 )  surface_waterflux             
471          CASE ( 's_surface' )
472             READ ( 13 )  s_surface
473          CASE ( 's_surface_initial_change' )
474             READ ( 13 )  s_surface_initial_change
475          CASE ( 's_vertical_gradient' )
476             READ ( 13 )  s_vertical_gradient
477          CASE ( 's_vertical_gradient_level' )
478             READ ( 13 )  s_vertical_gradient_level
479          CASE ( 'time_coupling' )
480             READ ( 13 )  time_coupling
481          CASE ( 'time_disturb' )
482             READ ( 13 )  time_disturb
483          CASE ( 'time_dopr' )
484             READ ( 13 )  time_dopr
485          CASE ( 'time_dopr_av' )
486             READ ( 13 )  time_dopr_av
487          CASE ( 'time_dopr_listing' )
488             READ ( 13 )  time_dopr_listing
489          CASE ( 'time_dopts' )
490             READ ( 13 )  time_dopts
491          CASE ( 'time_dosp' )
492             READ ( 13 )  time_dosp
493          CASE ( 'time_dots' )
494             READ ( 13 )  time_dots
495          CASE ( 'time_do2d_xy' )
496             READ ( 13 )  time_do2d_xy
497          CASE ( 'time_do2d_xz' )
498             READ ( 13 )  time_do2d_xz
499          CASE ( 'time_do2d_yz' )
500             READ ( 13 )  time_do2d_yz
501          CASE ( 'time_do3d' )
502             READ ( 13 )  time_do3d
503          CASE ( 'time_do_av' )
504             READ ( 13 )  time_do_av
505          CASE ( 'time_do_sla' )
506             READ ( 13 )  time_do_sla
507          CASE ( 'time_dvrp' )
508             READ ( 13 )  time_dvrp
509          CASE ( 'time_restart' )
510             READ ( 13 )  time_restart
511          CASE ( 'time_run_control' )
512             READ ( 13 )  time_run_control
513          CASE ( 'time_since_reference_point' )
514             READ ( 13 )  time_since_reference_point
515          CASE ( 'time_sort_particles' )
516             READ ( 13 )  time_sort_particles
517          CASE ( 'timestep_scheme' )
518             READ ( 13 )  timestep_scheme
519          CASE ( 'topography' )
520             READ ( 13 )  topography
521          CASE ( 'topography_grid_convention' )
522             READ ( 13 )  topography_grid_convention
523          CASE ( 'top_heatflux' )
524             READ ( 13 )  top_heatflux
525          CASE ( 'top_momentumflux_u' )
526             READ ( 13 )  top_momentumflux_u
527          CASE ( 'top_momentumflux_v' )
528             READ ( 13 )  top_momentumflux_v
529          CASE ( 'top_salinityflux' )
530             READ ( 13 )  top_salinityflux
531          CASE ( 'tsc' )
532             READ ( 13 )  tsc
533          CASE ( 'turbulent_inflow' )
534             READ ( 13 )  turbulent_inflow
535          CASE ( 'u_bulk' )
536             READ ( 13 )  u_bulk
537          CASE ( 'u_init' )
538             READ ( 13 )  u_init
539          CASE ( 'u_max' )
540             READ ( 13 )  u_max
541          CASE ( 'u_max_ijk' )
542             READ ( 13 )  u_max_ijk
543          CASE ( 'ug' )
544             READ ( 13 )  ug
545          CASE ( 'ug_surface' )
546             READ ( 13 )  ug_surface
547          CASE ( 'ug_vertical_gradient' )
548             READ ( 13 )  ug_vertical_gradient
549          CASE ( 'ug_vertical_gradient_level' )
550             READ ( 13 )  ug_vertical_gradient_level
551          CASE ( 'ug_vertical_gradient_level_ind' )
552             READ ( 13 )  ug_vertical_gradient_level_ind
553          CASE ( 'ups_limit_e' )
554             READ ( 13 )  ups_limit_e
555          CASE ( 'ups_limit_pt' )
556             READ ( 13 )  ups_limit_pt
557          CASE ( 'ups_limit_u' )
558             READ ( 13 )  ups_limit_u
559          CASE ( 'ups_limit_v' )
560             READ ( 13 )  ups_limit_v
561          CASE ( 'ups_limit_w' )
562             READ ( 13 )  ups_limit_w
563          CASE ( 'use_surface_fluxes' )
564             READ ( 13 )  use_surface_fluxes
565          CASE ( 'use_top_fluxes' )
566             READ ( 13 )  use_top_fluxes
567          CASE ( 'use_ug_for_galilei_tr' )
568             READ ( 13 )  use_ug_for_galilei_tr
569          CASE ( 'use_upstream_for_tke' )
570             READ ( 13 )  use_upstream_for_tke
571          CASE ( 'v_bulk' )
572             READ ( 13 )  v_bulk
573          CASE ( 'v_init' )
574             READ ( 13 )  v_init
575          CASE ( 'v_max' )
576             READ ( 13 )  v_max
577          CASE ( 'v_max_ijk' )
578             READ ( 13 )  v_max_ijk
579          CASE ( 'vg' )
580             READ ( 13 )  vg
581          CASE ( 'vg_surface' )
582             READ ( 13 )  vg_surface
583          CASE ( 'vg_vertical_gradient' )
584             READ ( 13 )  vg_vertical_gradient
585          CASE ( 'vg_vertical_gradient_level' )
586             READ ( 13 )  vg_vertical_gradient_level
587          CASE ( 'vg_vertical_gradient_level_ind' )
588             READ ( 13 )  vg_vertical_gradient_level_ind
589          CASE ( 'volume_flow_area' )
590             READ ( 13 )  volume_flow_area
591          CASE ( 'volume_flow_initial' )
592             READ ( 13 )  volume_flow_initial
593          CASE ( 'wall_adjustment' )
594             READ ( 13 )  wall_adjustment
595          CASE ( 'w_max' )
596             READ ( 13 )  w_max
597          CASE ( 'w_max_ijk' )
598             READ ( 13 )  w_max_ijk
599
600          CASE DEFAULT
601             WRITE( message_string, * ) 'unknown variable named "',         &
602                                        TRIM( variable_chr ), '" found in', &
603                                        ' data from prior run on PE ', myid 
604             CALL message( 'read_var_list', 'PA0302', 1, 2, 0, 6, 0 )
605        END SELECT
606!
607!--    Read next string
608       READ ( 13 )  variable_chr
609
610    ENDDO
611
612
613 END SUBROUTINE read_var_list
614
615
616
617 SUBROUTINE read_parts_of_var_list
618
619!------------------------------------------------------------------------------!
620! Description:
621! ------------
622! Skipping the global control variables from restart-file (binary format)
623! except some informations needed when reading restart data from a previous
624! run which used a smaller total domain or/and a different domain decomposition.
625!------------------------------------------------------------------------------!
626
627    USE arrays_3d
628    USE control_parameters
629    USE indices
630    USE pegrid
631    USE statistics
632
633    IMPLICIT NONE
634
635    CHARACTER (LEN=10) ::  version_on_file
636    CHARACTER (LEN=30) ::  variable_chr
637
638    INTEGER ::  idum, max_pr_user_on_file, nz_on_file, &
639                statistic_regions_on_file, tmp_mpru, tmp_sr
640
641    REAL, DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
642    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
643
644
645    CALL check_open( 13 )
646
647    WRITE (9,*) 'rpovl: after check open 13'
648    CALL local_flush( 9 )
649    READ ( 13 )  version_on_file
650
651!
652!-- Read number of PEs and horizontal index bounds of all PEs used in previous
653!-- run
654    READ ( 13 )  variable_chr
655    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
656       WRITE( message_string, * ) 'numprocs not found in data from prior ', &
657                                  'run on PE ', myid
658       CALL message( 'read_parts_of_var_list', 'PA0297', 1, 2, 0, 6, 0 )
659    ENDIF
660    READ ( 13 )  numprocs_previous_run
661
662    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
663       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
664    ENDIF
665
666    READ ( 13 )  variable_chr
667    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
668       WRITE( message_string, * ) 'hor_index_bounds not found in data from ', &
669                                  'prior run on PE ', myid
670       CALL message( 'read_parts_of_var_list', 'PA0298', 1, 2, 0, 6, 0 )
671    ENDIF
672    READ ( 13 )  hor_index_bounds_previous_run
673
674!
675!-- Read vertical number of gridpoints and number of different areas used
676!-- for computing statistics. Allocate arrays depending on these values,
677!-- which are needed for the following read instructions.
678    READ ( 13 )  variable_chr
679    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
680       message_string = 'nz not found in restart data file'
681       CALL message( 'read_parts_of_var_list', 'PA0303', 1, 2, 0, 6, 0 )
682    ENDIF
683    READ ( 13 )  nz_on_file
684    IF ( nz_on_file /= nz )  THEN
685       WRITE( message_string, * ) 'mismatch concerning number of ',      &
686                                  'gridpoints along z',                  &
687                                  '&nz on file    = "', nz_on_file, '"', &
688                                  '&nz from run   = "', nz, '"'
689       CALL message( 'read_parts_of_var_list', 'PA0304', 1, 2, 0, 6, 0 )
690    ENDIF
691
692    READ ( 13 )  variable_chr
693    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
694       message_string = 'max_pr_user not found in restart data file'
695       CALL message( 'read_parts_of_var_list', 'PA0305', 1, 2, 0, 6, 0 )
696    ENDIF
697    READ ( 13 )  max_pr_user_on_file
698    IF ( max_pr_user_on_file /= max_pr_user )  THEN
699       WRITE( message_string, * ) 'number of user profiles on res',           &
700                                  'tart data file differs from the current ', &
701                                  'run&max_pr_user on file    = "',           &
702                                  max_pr_user_on_file, '"',                   &
703                                  '&max_pr_user from run   = "',              &
704                                  max_pr_user, '"'
705       CALL message( 'read_parts_of_var_list', 'PA0306', 0, 0, 0, 6, 0 )
706       tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
707    ELSE
708       tmp_mpru = max_pr_user
709    ENDIF
710
711    READ ( 13 )  variable_chr
712    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
713       message_string = 'statistic_regions not found in restart data file'
714       CALL message( 'read_parts_of_var_list', 'PA0307', 1, 2, 0, 6, 0 )
715    ENDIF
716    READ ( 13 )  statistic_regions_on_file
717    IF ( statistic_regions_on_file /= statistic_regions )  THEN
718       WRITE( message_string, * ) 'statistic regions on restart data file ',& 
719                                  'differ from the current run',            &
720                                  '&statistic regions on file    = "',      &
721                                  statistic_regions_on_file, '"',           &
722                                  '&statistic regions from run   = "',      &
723                                   statistic_regions, '"',                  &
724                                  '&statistic data may be lost!'
725       CALL message( 'read_parts_of_var_list', 'PA0308', 0, 1, 0, 6, 0 )
726       tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
727    ELSE
728       tmp_sr = statistic_regions
729    ENDIF
730
731
732!
733!-- Now read and check some control parameters and skip the rest
734    WRITE (9,*) 'wpovl: begin reading variables'
735    CALL local_flush( 9 )
736    READ ( 13 )  variable_chr
737
738    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
739
740       SELECT CASE ( TRIM( variable_chr ) )
741
742          CASE ( 'average_count_pr' )
743             READ ( 13 )  average_count_pr
744             IF ( average_count_pr /= 0 )  THEN
745                WRITE( message_string, * ) 'inflow profiles not temporally ',  &
746                               'averaged. &Averaging will be done now using ', &
747                               average_count_pr, ' samples.'
748                CALL message( 'read_parts_of_var_list', 'PA0309', &
749                                                                 0, 1, 0, 6, 0 )
750             ENDIF
751
752          CASE ( 'hom' )
753             ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file, &
754                       0:statistic_regions_on_file) )
755             READ ( 13 )  hom_on_file
756             hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
757                          hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
758             DEALLOCATE( hom_on_file )
759
760          CASE ( 'hom_sum' )
761             ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file, &
762                       0:statistic_regions_on_file) )
763             READ ( 13 )  hom_sum_on_file
764             hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
765                          hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
766             DEALLOCATE( hom_sum_on_file )
767
768          CASE ( 'nx' )
769             READ ( 13 )  nx_on_file
770
771          CASE ( 'ny' )
772             READ ( 13 )  ny_on_file
773
774
775          CASE DEFAULT
776
777             READ ( 13 )  idum
778
779       END SELECT
780
781       READ ( 13 )  variable_chr
782
783    ENDDO
784
785!
786!-- Calculate the temporal average of vertical profiles, if neccessary
787    IF ( average_count_pr /= 0 )  THEN
788       hom_sum = hom_sum / REAL( average_count_pr )
789    ENDIF
790
791
792 END SUBROUTINE read_parts_of_var_list
793
794
795
796 SUBROUTINE skip_var_list
797
798!------------------------------------------------------------------------------!
799! Description:
800! ------------
801! Skipping the global control variables from restart-file (binary format)
802!------------------------------------------------------------------------------!
803
804    IMPLICIT NONE
805
806    CHARACTER (LEN=10) ::  version_on_file
807    CHARACTER (LEN=30) ::  variable_chr
808
809    INTEGER ::  idum
810
811
812    WRITE (9,*) 'skipvl #1'
813    CALL local_flush( 9 )
814    READ ( 13 )  version_on_file
815
816    WRITE (9,*) 'skipvl before variable_chr'
817    CALL local_flush( 9 )
818    READ ( 13 )  variable_chr
819    WRITE (9,*) 'skipvl after variable_chr'
820    CALL local_flush( 9 )
821
822    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
823
824    WRITE (9,*) 'skipvl chr = ', variable_chr
825    CALL local_flush( 9 )
826       READ ( 13 )  idum
827       READ ( 13 )  variable_chr
828
829    ENDDO
830    WRITE (9,*) 'skipvl last'
831    CALL local_flush( 9 )
832
833
834 END SUBROUTINE skip_var_list
Note: See TracBrowser for help on using the repository browser.