source: palm/tags/release-3.2a/SOURCE/read_var_list.f90 @ 157

Last change on this file since 157 was 77, checked in by raasch, 17 years ago

New:
---

particle reflection from vertical walls implemented, particle SGS model adjusted to walls

Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes, wall_fluxes_e. New 4D-array rif_wall.

new d3par-parameter netcdf_64bit_3d to switch on 64bit offset only for 3D files

new d3par-parameter dt_max to define the maximum value for the allowed timestep

new inipar-parameter loop_optimization to control the loop optimization method

new inipar-parameter pt_refrence. If given, this value is used as the reference that in buoyancy terms (otherwise, the instantaneous horizontally averaged temperature is used).

new user interface user_advec_particles

new initializing action "by_user" calls user_init_3d_model and allows the initial setting of all 3d arrays

topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files

samples added to the user interface which show how to add user-define time series quantities.

calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra*", "prr*", "z0*" with data_output). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval

unit 9 opened for debug output (file DEBUG_<pe#>)

Makefile, advec_particles, average_3d_data, buoyancy, calc_precipitation, check_open, check_parameters, data_output_2d, diffusion_e, diffusion_u, diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat, init_particles, init_3d_model, modules, netcdf, parin, production_e, read_var_list, read_3d_binary, sum_up_3d_data, user_interface, write_var_list, write_3d_binary

New: wall_fluxes

Changed:


General revision of non-cyclic horizontal boundary conditions: radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt, which are stored on new arrays u_m_l, u_m_r, etc.), calculation of mean outflow is not needed any more, volume flow control is added for the outflow boundary (currently only for the north boundary!!), additional gridpoints along x and y (uxrp, vynp) are not needed any more, routine "boundary_conds" now operates on timelevel t+dt and is not split in two parts (main, uvw_outflow) any more, Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d

The FFT-method for solving the Poisson-equation is now working with Neumann boundary conditions both at the bottom and the top. This requires adjustments of the tridiagonal coefficients and subtracting the horizontally averaged mean from the vertical velocity field.

+age_m in particle_type

Particles-package is now part of the default code ("-p particles" is not needed any more).

Move call of user_actions( 'after_integration' ) below increment of times
and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr)

d3par-parameter data_output_ts removed. Timeseries output for "profil" removed. Timeseries are now switched on by dt_dots. Timeseries data is collected in flow_statistics.

Initial velocities at nzb+1 are regarded for volume flow control in case they have been set zero before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc.

q is not allowed to become negative (prognostic_equations).

poisfft_init is only called if fft-solver is switched on (init_pegrid).

d3par-parameter moisture renamed to humidity.

Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc) file.

vtk directives removed from main program.

The uitility routine interpret_config reads PALM environment variables from NAMELIST instead using the system call GETENV.

advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, asselin_filter, check_parameters, coriolis, data_output_dvrp, data_output_ptseries, data_output_ts, data_output_2d, data_output_3d, diffusion_u, diffusion_v, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid, init_particles, init_pegrid, init_rankine, init_pt_anomaly, init_1d_model, init_3d_model, modules, palm, package_parin, parin, poisfft, poismg, prandtl_fluxes, pres, production_e, prognostic_equations, read_var_list, read_3d_binary, sor, swap_timelevel, time_integration, write_var_list, write_3d_binary

Errors:


Bugfix: preset of tendencies te_em, te_um, te_vm in init_1d_model

Bugfix in sample for reading user defined data from restart file (user_init)

Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model)

Check for possible negative humidities in the initial humidity profile.

in Makefile, default suffixes removed from the suffix list to avoid calling of m2c in
# case of .mod files

Makefile
check_parameters, init_1d_model, init_3d_model, user_interface

  • Property svn:keywords set to Id
File size: 15.0 KB
Line 
1 SUBROUTINE read_var_list
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: read_var_list.f90 77 2007-03-29 04:26:56Z letzel $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! +loop_optimization, pt_reference, moisture renamed humidity
14!
15! 20 2007-02-26 00:12:32Z raasch
16! +top_heatflux, use_top_fluxes
17!
18! RCS Log replace by Id keyword, revision history cleaned up
19!
20! Revision 1.34  2006/08/22 14:14:27  raasch
21! +dz_max
22!
23! Revision 1.1  1998/03/18 20:18:48  raasch
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Reading values of control variables from restart-file (binary format)
30!------------------------------------------------------------------------------!
31
32    USE arrays_3d
33    USE averaging
34    USE grid_variables
35    USE indices
36    USE model_1d
37    USE pegrid
38    USE profil_parameter
39    USE statistics
40    USE control_parameters
41
42    IMPLICIT NONE
43
44    CHARACTER (LEN=10) ::  binary_version, version_on_file
45    CHARACTER (LEN=30) ::  variable_chr
46   
47    CALL check_open( 13 )
48
49!
50!-- Make version number check first
51    READ ( 13 )  version_on_file
52    binary_version = '3.0'
53    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
54       IF ( myid == 0 )  THEN
55          PRINT*, '+++ read_var_list: version mismatch concerning control', &
56                  ' variables'
57          PRINT*, '                   version on file    = "', &
58                  TRIM( version_on_file ), '"'
59          PRINT*, '                   version on program = "', &
60                  TRIM( binary_version ), '"'
61       ENDIF
62       CALL local_stop
63    ENDIF
64
65!
66!-- Read vertical number of gridpoints and number of different areas used
67!-- for computing statistics. Allocate arrays depending on these values,
68!-- which are needed for the following read instructions.
69    READ ( 13 )  variable_chr
70    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
71       PRINT*, '+++ read_var_list: nz not found in data from prior run on PE ',&
72               myid
73       CALL local_stop
74    ENDIF
75    READ ( 13 )  nz
76    READ ( 13 )  variable_chr
77    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
78       PRINT*, '+++ read_var_list: statistic_regions not found in data from ', &
79                    'prior run on PE ', myid
80       CALL local_stop
81    ENDIF
82    READ ( 13 )  statistic_regions
83    ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1), v_init(0:nz+1), & 
84              pt_init(0:nz+1), q_init(0:nz+1), &
85              hom(0:nz+1,2,var_hom,0:statistic_regions) )
86
87!
88!-- Now read all control parameters:
89!-- Caution: When the following read instructions have been changed, the
90!-- -------  version number stored in the variable binary_version has to be
91!--          increased. The same changes must also be done in write_var_list.
92    READ ( 13 )  variable_chr
93    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
94
95       SELECT CASE ( TRIM( variable_chr ) )
96
97          CASE ( 'adjust_mixing_length' )
98             READ ( 13 )  adjust_mixing_length
99          CASE ( 'advected_distance_x' )
100             READ ( 13 )  advected_distance_x
101          CASE ( 'advected_distance_y' )
102             READ ( 13 )  advected_distance_y
103          CASE ( 'alpha_surface' )
104             READ ( 13 )  alpha_surface
105          CASE ( 'average_count_pr' )
106             READ ( 13 )  average_count_pr
107          CASE ( 'average_count_sp' )
108             READ ( 13 )  average_count_sp
109          CASE ( 'average_count_3d' )
110             READ ( 13 )  average_count_3d
111          CASE ( 'bc_e_b' )
112             READ ( 13 )  bc_e_b
113          CASE ( 'bc_lr' )
114             READ ( 13 )  bc_lr
115          CASE ( 'bc_ns' )
116             READ ( 13 )  bc_ns
117          CASE ( 'bc_p_b' )
118             READ ( 13 )  bc_p_b
119          CASE ( 'bc_p_t' )
120             READ ( 13 )  bc_p_t
121          CASE ( 'bc_pt_b' )
122             READ ( 13 )  bc_pt_b
123          CASE ( 'bc_pt_t' )
124             READ ( 13 )  bc_pt_t
125          CASE ( 'bc_pt_t_val' )
126             READ ( 13 )  bc_pt_t_val
127          CASE ( 'bc_q_b' )
128             READ ( 13 )  bc_q_b
129          CASE ( 'bc_q_t' )
130             READ ( 13 )  bc_q_t
131          CASE ( 'bc_q_t_val' )
132             READ ( 13 )  bc_q_t_val
133          CASE ( 'bc_s_b' )
134             READ ( 13 )  bc_s_b
135          CASE ( 'bc_s_t' )
136             READ ( 13 )  bc_s_t
137          CASE ( 'bc_uv_b' )
138             READ ( 13 )  bc_uv_b
139          CASE ( 'bc_uv_t' )
140             READ ( 13 )  bc_uv_t
141          CASE ( 'building_height' )
142             READ ( 13 )  building_height
143          CASE ( 'building_length_x' )
144             READ ( 13 )  building_length_x
145          CASE ( 'building_length_y' )
146             READ ( 13 )  building_length_y
147          CASE ( 'building_wall_left' )
148             READ ( 13 )  building_wall_left
149          CASE ( 'building_wall_south' )
150             READ ( 13 )  building_wall_south
151          CASE ( 'cloud_droplets' )
152             READ ( 13 )  cloud_droplets
153          CASE ( 'cloud_physics' )
154             READ ( 13 )  cloud_physics
155          CASE ( 'conserve_volume_flow' )
156             READ ( 13 )  conserve_volume_flow
157          CASE ( 'current_timestep_number' )
158             READ ( 13 )  current_timestep_number
159          CASE ( 'cut_spline_overshoot' )
160             READ ( 13 )  cut_spline_overshoot
161          CASE ( 'damp_level_1d' )
162             READ ( 13 )  damp_level_1d
163          CASE ( 'dissipation_1d' )
164             READ ( 13 )  dissipation_1d
165          CASE ( 'dt_fixed' )
166             READ ( 13 )  dt_fixed
167          CASE ( 'dt_pr_1d' )
168             READ ( 13 )  dt_pr_1d
169          CASE ( 'dt_run_control_1d' )
170             READ ( 13 )  dt_run_control_1d
171          CASE ( 'dt_3d' )
172             READ ( 13 )  dt_3d
173          CASE ( 'dvrp_filecount' )
174             READ ( 13 )  dvrp_filecount
175          CASE ( 'dx' )
176             READ ( 13 )  dx
177          CASE ( 'dy' )
178             READ ( 13 )  dy
179          CASE ( 'dz' )
180             READ ( 13 )  dz
181          CASE ( 'dz_max' )
182             READ ( 13 )  dz_max
183          CASE ( 'dz_stretch_factor' )
184             READ ( 13 )  dz_stretch_factor
185          CASE ( 'dz_stretch_level' )
186             READ ( 13 )  dz_stretch_level
187          CASE ( 'e_min' )
188             READ ( 13 )  e_min
189          CASE ( 'end_time_1d' )
190             READ ( 13 )  end_time_1d
191          CASE ( 'fft_method' )
192             READ ( 13 )  fft_method
193          CASE ( 'first_call_advec_particles' )
194             READ ( 13 )  first_call_advec_particles
195          CASE ( 'galilei_transformation' )
196             READ ( 13 )  galilei_transformation
197          CASE ( 'grid_matching' )
198             READ ( 13 )  grid_matching
199          CASE ( 'hom' )
200             READ ( 13 )  hom
201          CASE ( 'inflow_disturbance_begin' )
202             READ ( 13 )  inflow_disturbance_begin
203          CASE ( 'inflow_disturbance_end' )
204             READ ( 13 )  inflow_disturbance_end
205          CASE ( 'km_constant' )
206             READ ( 13 )  km_constant
207          CASE ( 'km_damp_max' )
208             READ ( 13 )  km_damp_max
209          CASE ( 'last_dt_change' )
210             READ ( 13 )  last_dt_change
211          CASE ( 'long_filter_factor' )
212             READ ( 13 )  long_filter_factor
213          CASE ( 'loop_optimization' )
214             READ ( 13 )  loop_optimization
215          CASE ( 'mixing_length_1d' )
216             READ ( 13 )  mixing_length_1d
217          CASE ( 'humidity' )
218             READ ( 13 )  humidity
219          CASE ( 'momentum_advec' )
220             READ ( 13 )  momentum_advec
221          CASE ( 'netcdf_precision' )
222             READ ( 13 )  netcdf_precision
223          CASE ( 'npex' )
224             READ ( 13 )  npex
225          CASE ( 'npey' )
226             READ ( 13 )  npey
227          CASE ( 'nsor_ini' )
228             READ ( 13 )  nsor_ini
229          CASE ( 'nx' )
230             READ ( 13 )  nx
231          CASE ( 'ny' )
232             READ ( 13 )  ny
233          CASE ( 'old_dt' )
234             READ ( 13 )  old_dt
235          CASE ( 'omega' )
236             READ ( 13 )  omega
237          CASE ( 'outflow_damping_width' )
238             READ ( 13 )  outflow_damping_width
239          CASE ( 'overshoot_limit_e' )
240             READ ( 13 )  overshoot_limit_e
241          CASE ( 'overshoot_limit_pt' )
242             READ ( 13 )  overshoot_limit_pt
243          CASE ( 'overshoot_limit_u' )
244             READ ( 13 )  overshoot_limit_u
245          CASE ( 'overshoot_limit_v' )
246             READ ( 13 )  overshoot_limit_v
247          CASE ( 'overshoot_limit_w' )
248             READ ( 13 )  overshoot_limit_w
249          CASE ( 'passive_scalar' )
250             READ ( 13 )  passive_scalar
251          CASE ( 'phi' )
252             READ ( 13 )  phi
253          CASE ( 'prandtl_layer' )
254             READ ( 13 )  prandtl_layer
255          CASE ( 'precipitation' )
256             READ ( 13 ) precipitation
257          CASE ( 'pt_init' )
258             READ ( 13 )  pt_init
259          CASE ( 'pt_reference' )
260             READ ( 13 )  pt_reference
261          CASE ( 'pt_surface' )
262             READ ( 13 )  pt_surface
263          CASE ( 'pt_surface_initial_change' )
264             READ ( 13 )  pt_surface_initial_change
265          CASE ( 'pt_vertical_gradient' )
266             READ ( 13 )  pt_vertical_gradient
267          CASE ( 'pt_vertical_gradient_level' )
268             READ ( 13 )  pt_vertical_gradient_level
269          CASE ( 'pt_vertical_gradient_level_ind' )
270             READ ( 13 )  pt_vertical_gradient_level_ind
271          CASE ( 'q_init' )
272             READ ( 13 )  q_init
273          CASE ( 'q_surface' )
274             READ ( 13 )  q_surface
275          CASE ( 'q_surface_initial_change' )
276             READ ( 13 )  q_surface_initial_change
277          CASE ( 'q_vertical_gradient' )
278             READ ( 13 )  q_vertical_gradient
279          CASE ( 'q_vertical_gradient_level' )
280             READ ( 13 )  q_vertical_gradient_level
281          CASE ( 'q_vertical_gradient_level_ind' )
282             READ ( 13 )  q_vertical_gradient_level_ind
283          CASE ( 'radiation' )
284             READ ( 13 )  radiation
285          CASE ( 'random_generator' )
286             READ ( 13 )  random_generator
287          CASE ( 'random_heatflux' )
288             READ ( 13 )  random_heatflux
289          CASE ( 'rif_max' )
290             READ ( 13 )  rif_max
291          CASE ( 'rif_min' )
292             READ ( 13 )  rif_min
293          CASE ( 'roughness_length' )
294             READ ( 13 )  roughness_length
295          CASE ( 'runnr' )
296             READ ( 13 )  runnr
297          CASE ( 'scalar_advec' )
298             READ ( 13 )  scalar_advec
299          CASE ( 'simulated_time' )
300             READ ( 13 )  simulated_time
301          CASE ( 'surface_heatflux' )
302             READ ( 13 )  surface_heatflux
303          CASE ( 'surface_pressure' )
304             READ ( 13 )  surface_pressure
305          CASE ( 'surface_scalarflux' )
306             READ ( 13 )  surface_scalarflux             
307          CASE ( 'surface_waterflux' )
308             READ ( 13 )  surface_waterflux             
309          CASE ( 's_surface' )
310             READ ( 13 )  s_surface
311          CASE ( 's_surface_initial_change' )
312             READ ( 13 )  s_surface_initial_change
313          CASE ( 's_vertical_gradient' )
314             READ ( 13 )  s_vertical_gradient
315          CASE ( 's_vertical_gradient_level' )
316             READ ( 13 )  s_vertical_gradient_level
317          CASE ( 'time_disturb' )
318             READ ( 13 )  time_disturb
319          CASE ( 'time_dopr' )
320             READ ( 13 )  time_dopr
321          CASE ( 'time_dopr_av' )
322             READ ( 13 )  time_dopr_av
323          CASE ( 'time_dopr_listing' )
324             READ ( 13 )  time_dopr_listing
325          CASE ( 'time_dopts' )
326             READ ( 13 )  time_dopts
327          CASE ( 'time_dosp' )
328             READ ( 13 )  time_dosp
329          CASE ( 'time_dots' )
330             READ ( 13 )  time_dots
331          CASE ( 'time_do2d_xy' )
332             READ ( 13 )  time_do2d_xy
333          CASE ( 'time_do2d_xz' )
334             READ ( 13 )  time_do2d_xz
335          CASE ( 'time_do2d_yz' )
336             READ ( 13 )  time_do2d_yz
337          CASE ( 'time_do3d' )
338             READ ( 13 )  time_do3d
339          CASE ( 'time_do_av' )
340             READ ( 13 )  time_do_av
341          CASE ( 'time_do_sla' )
342             READ ( 13 )  time_do_sla
343          CASE ( 'time_dvrp' )
344             READ ( 13 )  time_dvrp
345          CASE ( 'time_restart' )
346             READ ( 13 )  time_restart
347          CASE ( 'time_run_control' )
348             READ ( 13 )  time_run_control
349          CASE ( 'timestep_scheme' )
350             READ ( 13 )  timestep_scheme
351          CASE ( 'topography' )
352             READ ( 13 )  topography
353          CASE ( 'top_heatflux' )
354             READ ( 13 )  top_heatflux
355          CASE ( 'tsc' )
356             READ ( 13 )  tsc
357          CASE ( 'u_init' )
358             READ ( 13 )  u_init
359          CASE ( 'u_max' )
360             READ ( 13 )  u_max
361          CASE ( 'u_max_ijk' )
362             READ ( 13 )  u_max_ijk
363          CASE ( 'ug' )
364             READ ( 13 )  ug
365          CASE ( 'ug_surface' )
366             READ ( 13 )  ug_surface
367          CASE ( 'ug_vertical_gradient' )
368             READ ( 13 )  ug_vertical_gradient
369          CASE ( 'ug_vertical_gradient_level' )
370             READ ( 13 )  ug_vertical_gradient_level
371          CASE ( 'ug_vertical_gradient_level_ind' )
372             READ ( 13 )  ug_vertical_gradient_level_ind
373          CASE ( 'ups_limit_e' )
374             READ ( 13 )  ups_limit_e
375          CASE ( 'ups_limit_pt' )
376             READ ( 13 )  ups_limit_pt
377          CASE ( 'ups_limit_u' )
378             READ ( 13 )  ups_limit_u
379          CASE ( 'ups_limit_v' )
380             READ ( 13 )  ups_limit_v
381          CASE ( 'ups_limit_w' )
382             READ ( 13 )  ups_limit_w
383          CASE ( 'use_surface_fluxes' )
384             READ ( 13 )  use_surface_fluxes
385          CASE ( 'use_top_fluxes' )
386             READ ( 13 )  use_top_fluxes
387          CASE ( 'use_ug_for_galilei_tr' )
388             READ ( 13 )  use_ug_for_galilei_tr
389          CASE ( 'use_upstream_for_tke' )
390             READ ( 13 )  use_upstream_for_tke
391          CASE ( 'v_init' )
392             READ ( 13 )  v_init
393          CASE ( 'v_max' )
394             READ ( 13 )  v_max
395          CASE ( 'v_max_ijk' )
396             READ ( 13 )  v_max_ijk
397          CASE ( 'vg' )
398             READ ( 13 )  vg
399          CASE ( 'vg_surface' )
400             READ ( 13 )  vg_surface
401          CASE ( 'vg_vertical_gradient' )
402             READ ( 13 )  vg_vertical_gradient
403          CASE ( 'vg_vertical_gradient_level' )
404             READ ( 13 )  vg_vertical_gradient_level
405          CASE ( 'vg_vertical_gradient_level_ind' )
406             READ ( 13 )  vg_vertical_gradient_level_ind
407          CASE ( 'wall_adjustment' )
408             READ ( 13 )  wall_adjustment
409          CASE ( 'w_max' )
410             READ ( 13 )  w_max
411          CASE ( 'w_max_ijk' )
412             READ ( 13 )  w_max_ijk
413          CASE ( 'time-series-quantities' )
414             READ ( 13 )  cross_ts_uymax, cross_ts_uymax_computed, &
415                          cross_ts_uymin, cross_ts_uymin_computed
416
417          CASE DEFAULT
418             PRINT*, '+++ read_var_list: unknown variable named "', &
419                     TRIM( variable_chr ), '" found in'
420             PRINT*, '                   data from prior run on PE ', myid
421             CALL local_stop
422        END SELECT
423!
424!--    Read next string
425       READ ( 13 )  variable_chr
426
427    ENDDO
428
429
430 END SUBROUTINE read_var_list
Note: See TracBrowser for help on using the repository browser.