source: palm/tags/release-3.2/SOURCE/write_var_list.f90 @ 818

Last change on this file since 818 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: 14.5 KB
Line 
1 SUBROUTINE write_var_list
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: write_var_list.f90 77 2007-03-29 04:26:56Z maronga $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! +loop_optimization, pt_refrence, 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:30:52  raasch
21! +dz_max
22!
23! Revision 1.1  1998/03/18 20:20:38  raasch
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Writing values of control variables to 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
45
46
47
48    binary_version = '3.0'
49
50    WRITE ( 14 )  binary_version    ! opened in write_3d_binary
51
52    WRITE ( 14 )  'nz                            '
53    WRITE ( 14 )  nz
54    WRITE ( 14 )  'statistic_regions             '
55    WRITE ( 14 )  statistic_regions
56
57!
58!-- Caution: After changes in the following parameter-list, the
59!-- -------  version number stored in the variable binary_version has to be
60!--          increased. The same changes must also be done in the parameter-
61!--          list in read_var_list.
62
63    WRITE ( 14 )  'adjust_mixing_length          '
64    WRITE ( 14 )  adjust_mixing_length
65    WRITE ( 14 )  'advected_distance_x           '
66    WRITE ( 14 )  advected_distance_x
67    WRITE ( 14 )  'advected_distance_y           '
68    WRITE ( 14 )  advected_distance_y
69    WRITE ( 14 )  'alpha_surface                 '
70    WRITE ( 14 )  alpha_surface
71    WRITE ( 14 )  'average_count_pr              '
72    WRITE ( 14 )  average_count_pr
73    WRITE ( 14 )  'average_count_sp              '
74    WRITE ( 14 )  average_count_sp
75    WRITE ( 14 )  'average_count_3d              '
76    WRITE ( 14 )  average_count_3d
77    WRITE ( 14 )  'bc_e_b                        '
78    WRITE ( 14 )  bc_e_b
79    WRITE ( 14 )  'bc_lr                         '
80    WRITE ( 14 )  bc_lr
81    WRITE ( 14 )  'bc_ns                         '
82    WRITE ( 14 )  bc_ns
83    WRITE ( 14 )  'bc_p_b                        '
84    WRITE ( 14 )  bc_p_b
85    WRITE ( 14 )  'bc_p_t                        '
86    WRITE ( 14 )  bc_p_t
87    WRITE ( 14 )  'bc_pt_b                       '
88    WRITE ( 14 )  bc_pt_b
89    WRITE ( 14 )  'bc_pt_t                       '
90    WRITE ( 14 )  bc_pt_t
91    WRITE ( 14 )  'bc_pt_t_val                   '
92    WRITE ( 14 )  bc_pt_t_val
93    WRITE ( 14 )  'bc_q_b                        '
94    WRITE ( 14 )  bc_q_b
95    WRITE ( 14 )  'bc_q_t                        '
96    WRITE ( 14 )  bc_q_t
97    WRITE ( 14 )  'bc_q_t_val                    '
98    WRITE ( 14 )  bc_q_t_val
99    WRITE ( 14 )  'bc_s_b                        '
100    WRITE ( 14 )  bc_s_b
101    WRITE ( 14 )  'bc_s_t                        '
102    WRITE ( 14 )  bc_s_t
103    WRITE ( 14 )  'bc_uv_b                       '
104    WRITE ( 14 )  bc_uv_b
105    WRITE ( 14 )  'bc_uv_t                       '
106    WRITE ( 14 )  bc_uv_t
107    WRITE ( 14 )  'building_height               '
108    WRITE ( 14 )  building_height
109    WRITE ( 14 )  'building_length_x             '
110    WRITE ( 14 )  building_length_x
111    WRITE ( 14 )  'building_length_y             '
112    WRITE ( 14 )  building_length_y
113    WRITE ( 14 )  'building_wall_left            '
114    WRITE ( 14 )  building_wall_left
115    WRITE ( 14 )  'building_wall_south           '
116    WRITE ( 14 )  building_wall_south
117    WRITE ( 14 )  'cloud_droplets                '
118    WRITE ( 14 )  cloud_droplets
119    WRITE ( 14 )  'cloud_physics                 '
120    WRITE ( 14 )  cloud_physics
121    WRITE ( 14 )  'conserve_volume_flow          '
122    WRITE ( 14 )  conserve_volume_flow
123    WRITE ( 14 )  'current_timestep_number       '
124    WRITE ( 14 )  current_timestep_number
125    WRITE ( 14 )  'cut_spline_overshoot          '
126    WRITE ( 14 )  cut_spline_overshoot
127    WRITE ( 14 )  'damp_level_1d                 '
128    WRITE ( 14 )  damp_level_1d
129    WRITE ( 14 )  'dissipation_1d                '
130    WRITE ( 14 )  dissipation_1d
131    WRITE ( 14 )  'dt_fixed                      '
132    WRITE ( 14 )  dt_fixed
133    WRITE ( 14 )  'dt_pr_1d                      '
134    WRITE ( 14 )  dt_pr_1d
135    WRITE ( 14 )  'dt_run_control_1d             '
136    WRITE ( 14 )  dt_run_control_1d
137    WRITE ( 14 )  'dt_3d                         '
138    WRITE ( 14 )  dt_3d
139    WRITE ( 14 )  'dvrp_filecount                '
140    WRITE ( 14 )  dvrp_filecount
141    WRITE ( 14 )  'dx                            '
142    WRITE ( 14 )  dx
143    WRITE ( 14 )  'dy                            '
144    WRITE ( 14 )  dy
145    WRITE ( 14 )  'dz                            '
146    WRITE ( 14 )  dz
147    WRITE ( 14 )  'dz_max                        '
148    WRITE ( 14 )  dz_max
149    WRITE ( 14 )  'dz_stretch_factor             '
150    WRITE ( 14 )  dz_stretch_factor
151    WRITE ( 14 )  'dz_stretch_level              '
152    WRITE ( 14 )  dz_stretch_level
153    WRITE ( 14 )  'e_min                         '
154    WRITE ( 14 )  e_min
155    WRITE ( 14 )  'end_time_1d                   '
156    WRITE ( 14 )  end_time_1d
157    WRITE ( 14 )  'fft_method                    '
158    WRITE ( 14 )  fft_method
159    WRITE ( 14 )  'first_call_advec_particles    '
160    WRITE ( 14 )  first_call_advec_particles
161    WRITE ( 14 )  'galilei_transformation        '
162    WRITE ( 14 )  galilei_transformation
163    WRITE ( 14 )  'grid_matching                 '
164    WRITE ( 14 )  grid_matching
165    WRITE ( 14 )  'hom                           '
166    WRITE ( 14 )  hom
167    WRITE ( 14 )  'inflow_disturbance_begin      '
168    WRITE ( 14 )  inflow_disturbance_begin
169    WRITE ( 14 )  'inflow_disturbance_end        '
170    WRITE ( 14 )  inflow_disturbance_end
171    WRITE ( 14 )  'km_constant                   '
172    WRITE ( 14 )  km_constant
173    WRITE ( 14 )  'km_damp_max                   '
174    WRITE ( 14 )  km_damp_max
175    WRITE ( 14 )  'last_dt_change                '
176    WRITE ( 14 )  last_dt_change
177    WRITE ( 14 )  'long_filter_factor            '
178    WRITE ( 14 )  long_filter_factor
179    WRITE ( 14 )  'loop_optimization             '
180    WRITE ( 14 )  loop_optimization
181    WRITE ( 14 )  'mixing_length_1d              '
182    WRITE ( 14 )  mixing_length_1d
183    WRITE ( 14 )  'humidity                      '
184    WRITE ( 14 )  humidity
185    WRITE ( 14 )  'momentum_advec                '
186    WRITE ( 14 )  momentum_advec
187    WRITE ( 14 )  'netcdf_precision              '
188    WRITE ( 14 )  netcdf_precision
189    WRITE ( 14 )  'npex                          '
190    WRITE ( 14 )  npex
191    WRITE ( 14 )  'npey                          '
192    WRITE ( 14 )  npey
193    WRITE ( 14 )  'nsor_ini                      '
194    WRITE ( 14 )  nsor_ini
195    WRITE ( 14 )  'nx                            '
196    WRITE ( 14 )  nx
197    WRITE ( 14 )  'ny                            '
198    WRITE ( 14 )  ny
199    WRITE ( 14 )  'old_dt                        '
200    WRITE ( 14 )  old_dt
201    WRITE ( 14 )  'omega                         '
202    WRITE ( 14 )  omega
203    WRITE ( 14 )  'outflow_damping_width         '
204    WRITE ( 14 )  outflow_damping_width
205    WRITE ( 14 )  'overshoot_limit_e             '
206    WRITE ( 14 )  overshoot_limit_e
207    WRITE ( 14 )  'overshoot_limit_pt            '
208    WRITE ( 14 )  overshoot_limit_pt
209    WRITE ( 14 )  'overshoot_limit_u             '
210    WRITE ( 14 )  overshoot_limit_u
211    WRITE ( 14 )  'overshoot_limit_v             '
212    WRITE ( 14 )  overshoot_limit_v
213    WRITE ( 14 )  'overshoot_limit_w             '
214    WRITE ( 14 )  overshoot_limit_w
215    WRITE ( 14 )  'passive_scalar                '
216    WRITE ( 14 )  passive_scalar
217    WRITE ( 14 )  'phi                           '
218    WRITE ( 14 )  phi
219    WRITE ( 14 )  'prandtl_layer                 '
220    WRITE ( 14 )  prandtl_layer
221    WRITE ( 14 )  'precipitation                 '
222    WRITE ( 14 )  precipitation
223    WRITE ( 14 )  'pt_init                       '
224    WRITE ( 14 )  pt_init
225    WRITE ( 14 )  'pt_reference                  '
226    WRITE ( 14 )  pt_reference
227    WRITE ( 14 )  'pt_surface                    '
228    WRITE ( 14 )  pt_surface
229    WRITE ( 14 )  'pt_surface_initial_change     '
230    WRITE ( 14 )  pt_surface_initial_change
231    WRITE ( 14 )  'pt_vertical_gradient          '
232    WRITE ( 14 )  pt_vertical_gradient
233    WRITE ( 14 )  'pt_vertical_gradient_level    '
234    WRITE ( 14 )  pt_vertical_gradient_level
235    WRITE ( 14 )  'pt_vertical_gradient_level_ind'
236    WRITE ( 14 )  pt_vertical_gradient_level_ind
237    WRITE ( 14 )  'q_init                        '
238    WRITE ( 14 )  q_init
239    WRITE ( 14 )  'q_surface                     '
240    WRITE ( 14 )  q_surface
241    WRITE ( 14 )  'q_surface_initial_change      '
242    WRITE ( 14 )  q_surface_initial_change
243    WRITE ( 14 )  'q_vertical_gradient           '
244    WRITE ( 14 )  q_vertical_gradient
245    WRITE ( 14 )  'q_vertical_gradient_level     '
246    WRITE ( 14 )  q_vertical_gradient_level
247    WRITE ( 14 )  'q_vertical_gradient_level_ind '
248    WRITE ( 14 )  q_vertical_gradient_level_ind
249    WRITE ( 14 )  'radiation                     '
250    WRITE ( 14 )  radiation
251    WRITE ( 14 )  'random_generator              '
252    WRITE ( 14 )  random_generator
253    WRITE ( 14 )  'random_heatflux               '
254    WRITE ( 14 )  random_heatflux
255    WRITE ( 14 )  'rif_max                       '
256    WRITE ( 14 )  rif_max
257    WRITE ( 14 )  'rif_min                       '
258    WRITE ( 14 )  rif_min
259    WRITE ( 14 )  'roughness_length              '
260    WRITE ( 14 )  roughness_length
261    WRITE ( 14 )  'runnr                         '
262    WRITE ( 14 )  runnr
263    WRITE ( 14 )  'scalar_advec                  '
264    WRITE ( 14 )  scalar_advec
265    WRITE ( 14 )  'simulated_time                '
266    WRITE ( 14 )  simulated_time
267    WRITE ( 14 )  'surface_heatflux              '
268    WRITE ( 14 )  surface_heatflux
269    WRITE ( 14 )  'surface_pressure              '
270    WRITE ( 14 )  surface_pressure
271    WRITE ( 14 )  'surface_scalarflux            '
272    WRITE ( 14 )  surface_scalarflux   
273    WRITE ( 14 )  'surface_waterflux             '
274    WRITE ( 14 )  surface_waterflux   
275    WRITE ( 14 )  's_surface                     '
276    WRITE ( 14 )  s_surface
277    WRITE ( 14 )  's_surface_initial_change      '
278    WRITE ( 14 )  s_surface_initial_change
279    WRITE ( 14 )  's_vertical_gradient           '
280    WRITE ( 14 )  s_vertical_gradient
281    WRITE ( 14 )  's_vertical_gradient_level     '
282    WRITE ( 14 )  s_vertical_gradient_level
283    WRITE ( 14 )  'time_disturb                  '
284    WRITE ( 14 )  time_disturb
285    WRITE ( 14 )  'time_dopr                     '
286    WRITE ( 14 )  time_dopr
287    WRITE ( 14 )  'time_dopr_av                  '
288    WRITE ( 14 )  time_dopr_av
289    WRITE ( 14 )  'time_dopr_listing             '
290    WRITE ( 14 )  time_dopr_listing
291    WRITE ( 14 )  'time_dopts                    '
292    WRITE ( 14 )  time_dopts
293    WRITE ( 14 )  'time_dosp                     '
294    WRITE ( 14 )  time_dosp
295    WRITE ( 14 )  'time_dots                     '
296    WRITE ( 14 )  time_dots
297    WRITE ( 14 )  'time_do2d_xy                  '
298    WRITE ( 14 )  time_do2d_xy
299    WRITE ( 14 )  'time_do2d_xz                  '
300    WRITE ( 14 )  time_do2d_xz
301    WRITE ( 14 )  'time_do2d_yz                  '
302    WRITE ( 14 )  time_do2d_yz
303    WRITE ( 14 )  'time_do3d                     '
304    WRITE ( 14 )  time_do3d
305    WRITE ( 14 )  'time_do_av                    '
306    WRITE ( 14 )  time_do_av
307    WRITE ( 14 )  'time_do_sla                   '
308    WRITE ( 14 )  time_do_sla
309    WRITE ( 14 )  'time_dvrp                     '
310    WRITE ( 14 )  time_dvrp
311    WRITE ( 14 )  'time_restart                  '
312    WRITE ( 14 )  time_restart
313    WRITE ( 14 )  'time_run_control              '
314    WRITE ( 14 )  time_run_control
315    WRITE ( 14 )  'timestep_scheme               '
316    WRITE ( 14 )  timestep_scheme
317    WRITE ( 14 )  'topography                    '
318    WRITE ( 14 )  topography
319    WRITE ( 14 )  'top_heatflux                  '
320    WRITE ( 14 )  top_heatflux
321    WRITE ( 14 )  'tsc                           '
322    WRITE ( 14 )  tsc
323    WRITE ( 14 )  'u_init                        '
324    WRITE ( 14 )  u_init
325    WRITE ( 14 )  'u_max                         '
326    WRITE ( 14 )  u_max
327    WRITE ( 14 )  'u_max_ijk                     '
328    WRITE ( 14 )  u_max_ijk
329    WRITE ( 14 )  'ug                            '
330    WRITE ( 14 )  ug
331    WRITE ( 14 )  'ug_surface                    '
332    WRITE ( 14 )  ug_surface
333    WRITE ( 14 )  'ug_vertical_gradient          '
334    WRITE ( 14 )  ug_vertical_gradient
335    WRITE ( 14 )  'ug_vertical_gradient_level    '
336    WRITE ( 14 )  ug_vertical_gradient_level
337    WRITE ( 14 )  'ug_vertical_gradient_level_ind'
338    WRITE ( 14 )  ug_vertical_gradient_level_ind
339    WRITE ( 14 )  'ups_limit_e                   '
340    WRITE ( 14 )  ups_limit_e
341    WRITE ( 14 )  'ups_limit_pt                  '
342    WRITE ( 14 )  ups_limit_pt
343    WRITE ( 14 )  'ups_limit_u                   '
344    WRITE ( 14 )  ups_limit_u
345    WRITE ( 14 )  'ups_limit_v                   '
346    WRITE ( 14 )  ups_limit_v
347    WRITE ( 14 )  'ups_limit_w                   '
348    WRITE ( 14 )  ups_limit_w
349    WRITE ( 14 )  'use_surface_fluxes            '
350    WRITE ( 14 )  use_surface_fluxes
351    WRITE ( 14 )  'use_top_fluxes                '
352    WRITE ( 14 )  use_top_fluxes
353    WRITE ( 14 )  'use_ug_for_galilei_tr         '
354    WRITE ( 14 )  use_ug_for_galilei_tr
355    WRITE ( 14 )  'use_upstream_for_tke          '
356    WRITE ( 14 )  use_upstream_for_tke
357    WRITE ( 14 )  'v_init                        '
358    WRITE ( 14 )  v_init
359    WRITE ( 14 )  'v_max                         '
360    WRITE ( 14 )  v_max
361    WRITE ( 14 )  'v_max_ijk                     '
362    WRITE ( 14 )  v_max_ijk
363    WRITE ( 14 )  'vg                            '
364    WRITE ( 14 )  vg
365    WRITE ( 14 )  'vg_surface                    '
366    WRITE ( 14 )  vg_surface
367    WRITE ( 14 )  'vg_vertical_gradient          '
368    WRITE ( 14 )  vg_vertical_gradient
369    WRITE ( 14 )  'vg_vertical_gradient_level    '
370    WRITE ( 14 )  vg_vertical_gradient_level
371    WRITE ( 14 )  'vg_vertical_gradient_level_ind'
372    WRITE ( 14 )  vg_vertical_gradient_level_ind
373    WRITE ( 14 )  'wall_adjustment               '
374    WRITE ( 14 )  wall_adjustment
375    WRITE ( 14 )  'w_max                         '
376    WRITE ( 14 )  w_max
377    WRITE ( 14 )  'w_max_ijk                     '
378    WRITE ( 14 )  w_max_ijk
379    WRITE ( 14 )  'time-series-quantities        '
380    WRITE ( 14 )  cross_ts_uymax, cross_ts_uymax_computed, cross_ts_uymin, &
381                  cross_ts_uymin_computed
382
383!
384!-- Set the end-of-file mark
385    WRITE ( 14 )  '*** end ***                   '
386
387
388 END SUBROUTINE write_var_list
Note: See TracBrowser for help on using the repository browser.