source: palm/tags/release-3.2b/SOURCE/write_3d_binary.f90 @ 170

Last change on this file since 170 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: 11.4 KB
Line 
1 SUBROUTINE write_3d_binary
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: write_3d_binary.f90 77 2007-03-29 04:26:56Z raasch $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,
14! z0_av, moisture renamed humidity
15!
16! 19 2007-02-23 04:53:48Z raasch
17! +qswst, qswst_m, tswst, tswst_m
18!
19! RCS Log replace by Id keyword, revision history cleaned up
20!
21! Revision 1.21  2006/08/04 15:05:11  raasch
22! +iran, iran_part
23!
24! Revision 1.1  1998/03/18 20:20:21  raasch
25! Initial revision
26!
27!
28! Description:
29! ------------
30! Binary output of variables and arrays for restarts.
31!------------------------------------------------------------------------------!
32
33    USE arrays_3d
34    USE averaging
35    USE cloud_parameters
36    USE control_parameters
37    USE cpulog
38    USE indices
39    USE interfaces
40    USE particle_attributes
41    USE pegrid
42    USE profil_parameter
43    USE random_function_mod
44    USE statistics
45
46    IMPLICIT NONE
47
48    CHARACTER (LEN=10) ::  binary_version
49
50
51    CALL cpu_log( log_point(22), 'write_3d_binary', 'start' )
52
53    CALL check_open( 14 )
54   
55!
56!-- Write control parameters and other variables for restart.
57    CALL write_var_list
58
59!
60!-- Write arrays.
61    binary_version = '3.0'
62
63    WRITE ( 14 )  binary_version
64
65    WRITE ( 14 )  numprocs, myid, nxl, nxr, nys, nyn, nzb, nzt
66
67!
68!-- Attention: After changes to the following output commands the version number
69!-- ---------  of the variable binary_version must be changed!
70!--            Also, the list of arrays to be read in read_3d_binary must be
71!--            adjusted accordingly.
72
73    WRITE ( 14 )  'e                   ';  WRITE ( 14 )  e
74    IF ( ALLOCATED( e_av ) )  THEN
75       WRITE ( 14 )  'e_av                ';  WRITE ( 14 )  e_av
76    ENDIF
77    WRITE ( 14 )  'e_m                 ';  WRITE ( 14 )  e_m
78    WRITE ( 14 )  'iran                ';  WRITE ( 14 )  iran, iran_part
79    WRITE ( 14 )  'kh                  ';  WRITE ( 14 )  kh
80    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
81       WRITE ( 14 )  'kh_m                ';  WRITE ( 14 )  kh_m
82    ENDIF
83    WRITE ( 14 )  'km                  ';  WRITE ( 14 )  km
84    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
85       WRITE ( 14 )  'km_m                ';  WRITE ( 14 )  km_m
86    ENDIF
87    IF ( ALLOCATED( lwp_av ) )  THEN
88       WRITE ( 14 )  'lwp_av              ';  WRITE ( 14 )  lwp_av
89    ENDIF
90    WRITE ( 14 )  'p                   ';  WRITE ( 14 )  p
91    IF ( ALLOCATED( p_av ) )  THEN
92       WRITE ( 14 )  'p_av                ';  WRITE ( 14 )  p_av
93    ENDIF
94    IF ( ALLOCATED( pc_av ) )  THEN
95       WRITE ( 14 )  'pc_av               ';  WRITE ( 14 )  pc_av
96    ENDIF
97    IF ( ALLOCATED( pr_av ) )  THEN
98       WRITE ( 14 )  'pr_av               ';  WRITE ( 14 )  pr_av
99    ENDIF
100    IF ( ALLOCATED( precipitation_amount ) )  THEN
101       WRITE ( 14 )  'precipitation_amount';  WRITE ( 14 )  precipitation_amount
102    ENDIF
103    IF ( ALLOCATED( precipitation_rate_av ) )  THEN
104       WRITE ( 14 )  'precipitation_rate_a';  WRITE ( 14 )  &
105                                                           precipitation_rate_av
106    ENDIF
107    WRITE ( 14 )  'pt                  ';  WRITE ( 14 )  pt
108    IF ( ALLOCATED( pt_av ) )  THEN
109       WRITE ( 14 )  'pt_av               ';  WRITE ( 14 )  pt_av
110    ENDIF
111    WRITE ( 14 )  'pt_m                ';  WRITE ( 14 )  pt_m
112    IF ( humidity  .OR. passive_scalar )  THEN
113       WRITE ( 14 )  'q                   ';  WRITE ( 14 )  q 
114       IF ( ALLOCATED( q_av ) )  THEN
115          WRITE ( 14 )  'q_av                ';  WRITE ( 14 )  q_av
116       ENDIF
117       WRITE ( 14 )  'q_m                 ';  WRITE ( 14 ) q_m
118       IF ( cloud_physics ) THEN
119          WRITE ( 14 )  'ql                  ';  WRITE ( 14 ) ql
120          IF ( ALLOCATED( ql_av ) )  THEN
121             WRITE ( 14 )  'ql_av               ';  WRITE ( 14 )  ql_av
122          ENDIF
123       ENDIF
124       WRITE ( 14 )  'qs                  ';  WRITE ( 14 ) qs
125       WRITE ( 14 )  'qsws                ';  WRITE ( 14 ) qsws
126       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
127          WRITE ( 14 )  'qsws_m              ';  WRITE ( 14 ) qsws_m
128       ENDIF
129       WRITE ( 14 )  'qswst               ';  WRITE ( 14 ) qswst
130       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
131          WRITE ( 14 )  'qswst_m             ';  WRITE ( 14 ) qswst_m
132       ENDIF
133    ENDIF
134    IF ( ALLOCATED( ql_c_av ) )  THEN
135       WRITE ( 14 )  'ql_c_av             ';  WRITE ( 14 )  ql_c_av
136    ENDIF
137    IF ( ALLOCATED( ql_v_av ) )  THEN
138       WRITE ( 14 )  'ql_v_av             ';  WRITE ( 14 )  ql_v_av
139    ENDIF
140    IF ( ALLOCATED( ql_vp_av ) )  THEN
141       WRITE ( 14 )  'ql_vp_av            ';  WRITE ( 14 )  ql_vp_av
142    ENDIF
143    IF ( ALLOCATED( qv_av ) )  THEN
144       WRITE ( 14 )  'qv_av               ';  WRITE ( 14 )  qv_av
145    ENDIF
146    WRITE ( 14 )  'random_iv           ';  WRITE ( 14 )  random_iv
147                                           WRITE ( 14 )  random_iy
148    WRITE ( 14 )  'rif                 ';  WRITE ( 14 )  rif
149    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
150       WRITE ( 14 )  'rif_m               ';  WRITE ( 14 )  rif_m
151    ENDIF
152    IF ( topography /= 'flat' )  THEN
153       WRITE ( 14 )  'rif_wall            ';  WRITE ( 14 )  rif_wall
154    ENDIF
155    IF ( ALLOCATED( s_av ) )  THEN
156       WRITE ( 14 )  's_av                ';  WRITE ( 14 )  s_av
157    ENDIF
158    WRITE ( 14 )  'shf                 ';  WRITE ( 14 )  shf
159    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
160       WRITE ( 14 )  'shf_m               ';  WRITE ( 14 )  shf_m
161    ENDIF
162    WRITE ( 14 )  'ts                  ';  WRITE ( 14 )  ts
163    IF ( ALLOCATED( ts_av ) )  THEN
164       WRITE ( 14 )  'ts_av               ';  WRITE ( 14 )  ts_av
165    ENDIF
166    WRITE ( 14 )  'tswst               ';  WRITE ( 14 )  tswst
167    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
168       WRITE ( 14 )  'tswst_m             ';  WRITE ( 14 )  tswst_m
169    ENDIF
170    WRITE ( 14 )  'u                   ';  WRITE ( 14 )  u
171    IF ( ALLOCATED( u_av ) )  THEN
172       WRITE ( 14 )  'u_av                ';  WRITE ( 14 )  u_av
173    ENDIF
174    WRITE ( 14 )  'u_m                 ';  WRITE ( 14 )  u_m
175    IF ( ALLOCATED( u_m_l ) )  THEN
176       WRITE ( 14 )  'u_m_l               ';  WRITE ( 14 )  u_m_l
177    ENDIF
178    IF ( ALLOCATED( u_m_n ) )  THEN
179       WRITE ( 14 )  'u_m_n               ';  WRITE ( 14 )  u_m_n
180    ENDIF
181    IF ( ALLOCATED( u_m_r ) )  THEN
182       WRITE ( 14 )  'u_m_r               ';  WRITE ( 14 )  u_m_r
183    ENDIF
184    IF ( ALLOCATED( u_m_s ) )  THEN
185       WRITE ( 14 )  'u_m_s               ';  WRITE ( 14 )  u_m_s
186    ENDIF
187    WRITE ( 14 )  'us                  ';  WRITE ( 14 )  us
188    WRITE ( 14 )  'usws                ';  WRITE ( 14 )  usws
189    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
190       WRITE ( 14 )  'usws_m              ';  WRITE ( 14 )  usws_m
191    ENDIF
192    IF ( ALLOCATED( us_av ) )  THEN
193       WRITE ( 14 )  'us_av               ';  WRITE ( 14 )  us_av
194    ENDIF
195    WRITE ( 14 )  'v                   ';  WRITE ( 14 )  v
196    WRITE ( 14 )  'volume_flow_area    ';  WRITE ( 14 )  volume_flow_area
197    WRITE ( 14 )  'volume_flow_initial ';  WRITE ( 14 )  volume_flow_initial
198    IF ( ALLOCATED( v_av ) )  THEN
199       WRITE ( 14 )  'v_av                ';  WRITE ( 14 )  v_av
200    ENDIF
201    WRITE ( 14 )  'v_m                 ';  WRITE ( 14 )  v_m
202    IF ( ALLOCATED( v_m_l ) )  THEN
203       WRITE ( 14 )  'v_m_l               ';  WRITE ( 14 )  v_m_l
204    ENDIF
205    IF ( ALLOCATED( v_m_n ) )  THEN
206       WRITE ( 14 )  'v_m_n               ';  WRITE ( 14 )  v_m_n
207    ENDIF
208    IF ( ALLOCATED( v_m_r ) )  THEN
209       WRITE ( 14 )  'v_m_r               ';  WRITE ( 14 )  v_m_r
210    ENDIF
211    IF ( ALLOCATED( v_m_s ) )  THEN
212       WRITE ( 14 )  'v_m_s               ';  WRITE ( 14 )  v_m_s
213    ENDIF
214    IF ( humidity )  THEN
215       WRITE ( 14 )  'vpt                 ';  WRITE ( 14 )  vpt
216       IF ( ALLOCATED( vpt_av ) )  THEN
217          WRITE ( 14 )  'vpt_av              ';  WRITE ( 14 )  vpt_av
218       ENDIF
219       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
220          WRITE ( 14 )  'vpt_m               ';  WRITE ( 14 )  vpt_m
221       ENDIF
222    ENDIF
223    WRITE ( 14 )  'vsws                ';  WRITE ( 14 )  vsws
224    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
225       WRITE ( 14 )  'vsws_m              ';  WRITE ( 14 )  vsws_m
226    ENDIF
227    WRITE ( 14 )  'w                   ';  WRITE ( 14 )  w
228    IF ( ALLOCATED( w_av ) )  THEN
229       WRITE ( 14 )  'w_av                ';  WRITE ( 14 )  w_av
230    ENDIF
231    WRITE ( 14 )  'w_m                 ';  WRITE ( 14 )  w_m
232    IF ( ALLOCATED( w_m_l ) )  THEN
233       WRITE ( 14 )  'w_m_l               ';  WRITE ( 14 )  w_m_l
234    ENDIF
235    IF ( ALLOCATED( w_m_n ) )  THEN
236       WRITE ( 14 )  'w_m_n               ';  WRITE ( 14 )  w_m_n
237    ENDIF
238    IF ( ALLOCATED( w_m_r ) )  THEN
239       WRITE ( 14 )  'w_m_r               ';  WRITE ( 14 )  w_m_r
240    ENDIF
241    IF ( ALLOCATED( w_m_s ) )  THEN
242       WRITE ( 14 )  'w_m_s               ';  WRITE ( 14 )  w_m_s
243    ENDIF
244    WRITE ( 14 )  'z0                  ';  WRITE ( 14 )  z0
245    IF ( ALLOCATED( z0_av ) )  THEN
246       WRITE ( 14 )  'z0_av               ';  WRITE ( 14 )  z0_av
247    ENDIF
248
249    WRITE ( 14 )  'cross_linecolors    ';  WRITE ( 14 )  cross_linecolors
250    WRITE ( 14 )  'cross_linestyles    ';  WRITE ( 14 )  cross_linestyles
251    WRITE ( 14 )  'cross_normalized_x  ';  WRITE ( 14 )  cross_normalized_x
252    WRITE ( 14 )  'cross_normalized_y  ';  WRITE ( 14 )  cross_normalized_y
253    WRITE ( 14 )  'cross_normx_factor  ';  WRITE ( 14 )  cross_normx_factor
254    WRITE ( 14 )  'cross_normy_factor  ';  WRITE ( 14 )  cross_normy_factor
255    WRITE ( 14 )  'cross_profiles      ';  WRITE ( 14 )  cross_profiles
256    WRITE ( 14 )  'cross_profile_n_coun'
257                  WRITE ( 14 )  cross_profile_number_count
258    WRITE ( 14 )  'cross_profile_number';  WRITE ( 14 )  cross_profile_numbers
259    WRITE ( 14 )  'cross_uxmax         ';  WRITE ( 14 )  cross_uxmax
260    WRITE ( 14 )  'cross_uxmax_computed';  WRITE ( 14 )  cross_uxmax_computed
261    WRITE ( 14 )  'cross_uxmax_normaliz';  WRITE ( 14 )  cross_uxmax_normalized
262    WRITE ( 14 )  'cross_uxmax_norm_com'
263                  WRITE ( 14 )  cross_uxmax_normalized_computed
264    WRITE ( 14 )  'cross_uxmin         ';  WRITE ( 14 )  cross_uxmin
265    WRITE ( 14 )  'cross_uxmin_computed';  WRITE ( 14 )  cross_uxmin_computed
266    WRITE ( 14 )  'cross_uxmin_normaliz';  WRITE ( 14 )  cross_uxmin_normalized
267    WRITE ( 14 )  'cross_uxmin_norm_com'
268                  WRITE ( 14 )  cross_uxmin_normalized_computed
269    WRITE ( 14 )  'cross_uymax         ';  WRITE ( 14 )  cross_uymax
270    WRITE ( 14 )  'cross_uymin         ';  WRITE ( 14 )  cross_uymin
271    WRITE ( 14 )  'cross_xtext         ';  WRITE ( 14 )  cross_xtext
272    WRITE ( 14 )  'dopr_crossindex     ';  WRITE ( 14 )  dopr_crossindex
273    WRITE ( 14 )  'dopr_time_count     ';  WRITE ( 14 )  dopr_time_count
274    WRITE ( 14 )  'hom_sum             ';  WRITE ( 14 )  hom_sum
275    WRITE ( 14 )  'profile_columns     ';  WRITE ( 14 )  profile_columns
276    WRITE ( 14 )  'profile_number      ';  WRITE ( 14 )  profile_number
277    WRITE ( 14 )  'profile_rows        ';  WRITE ( 14 )  profile_rows
278    IF ( ALLOCATED( spectrum_x ) )  THEN
279       WRITE ( 14 )  'spectrum_x          ';  WRITE ( 14 )  spectrum_x
280       WRITE ( 14 )  'spectrum_y          ';  WRITE ( 14 )  spectrum_y
281    ENDIF
282
283!
284!-- Write end label. Unit 14 is closed in the main program.
285    WRITE ( 14 )  '*** end ***         '
286
287
288    CALL cpu_log( log_point(22), 'write_3d_binary', 'stop' )
289
290
291 END SUBROUTINE write_3d_binary
Note: See TracBrowser for help on using the repository browser.