source: palm/tags/release-3.2b/SOURCE/average_3d_data.f90 @ 2977

Last change on this file since 2977 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: 6.8 KB
Line 
1 SUBROUTINE average_3d_data
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: average_3d_data.f90 77 2007-03-29 04:26:56Z kanani $
11!
12! 72 2007-03-19 08:20:46Z raasch
13! Averaging the precipitation rate and roughness length (prr*, z0*)
14!
15! RCS Log replace by Id keyword, revision history cleaned up
16!
17! Revision 1.1  2006/02/23 09:48:58  raasch
18! Initial revision
19!
20!
21! Description:
22! ------------
23! Time-averaging of 3d-data-arrays.
24!------------------------------------------------------------------------------!
25
26    USE arrays_3d
27    USE averaging
28    USE cloud_parameters
29    USE control_parameters
30    USE cpulog
31    USE indices
32    USE interfaces
33
34    IMPLICIT NONE
35
36    INTEGER ::  i, ii, j, k
37
38
39    CALL cpu_log (log_point(35),'average_3d_data','start')
40
41!
42!-- Check, if averaging is necessary
43    IF ( average_count_3d <= 1 )  RETURN
44
45!
46!-- Loop of all variables to be averaged.
47    DO  ii = 1, doav_n
48
49!
50!--    Store the array chosen on the temporary array.
51       SELECT CASE ( TRIM( doav(ii) ) )
52
53          CASE ( 'e' )
54             DO  i = nxl-1, nxr+1
55                DO  j = nys-1, nyn+1
56                   DO  k = nzb, nzt+1
57                      e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d )
58                   ENDDO
59                ENDDO
60             ENDDO
61
62          CASE ( 'lwp*' )
63             DO  i = nxl-1, nxr+1
64                DO  j = nys-1, nyn+1
65                   lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d )
66                ENDDO
67             ENDDO
68
69          CASE ( 'p' )
70             DO  i = nxl-1, nxr+1
71                DO  j = nys-1, nyn+1
72                   DO  k = nzb, nzt+1
73                      p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d )
74                   ENDDO
75                ENDDO
76             ENDDO
77
78          CASE ( 'pc' )
79             DO  i = nxl, nxr
80                DO  j = nys, nyn
81                   DO  k = nzb, nzt+1
82                      pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d )
83                   ENDDO
84                ENDDO
85             ENDDO
86
87          CASE ( 'pr' )
88             DO  i = nxl, nxr
89                DO  j = nys, nyn
90                   DO  k = nzb, nzt+1
91                      pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d )
92                   ENDDO
93                ENDDO
94             ENDDO
95
96          CASE ( 'prr*' )
97             DO  i = nxl-1, nxr+1
98                DO  j = nys-1, nyn+1
99                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) / &
100                                                REAL( average_count_3d )
101                ENDDO
102             ENDDO
103
104          CASE ( 'pt' )
105             DO  i = nxl-1, nxr+1
106                DO  j = nys-1, nyn+1
107                   DO  k = nzb, nzt+1
108                      pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d )
109                   ENDDO
110                ENDDO
111             ENDDO
112
113          CASE ( 'q' )
114             DO  i = nxl-1, nxr+1
115                DO  j = nys-1, nyn+1
116                   DO  k = nzb, nzt+1
117                      q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d )
118                   ENDDO
119                ENDDO
120             ENDDO
121             
122          CASE ( 'ql' )
123             DO  i = nxl-1, nxr+1
124                DO  j = nys-1, nyn+1
125                   DO  k = nzb, nzt+1
126                      ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d )
127                   ENDDO
128                ENDDO
129             ENDDO
130
131          CASE ( 'ql_c' )
132             DO  i = nxl-1, nxr+1
133                DO  j = nys-1, nyn+1
134                   DO  k = nzb, nzt+1
135                      ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d )
136                   ENDDO
137                ENDDO
138             ENDDO
139
140          CASE ( 'ql_v' )
141             DO  i = nxl-1, nxr+1
142                DO  j = nys-1, nyn+1
143                   DO  k = nzb, nzt+1
144                      ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d )
145                   ENDDO
146                ENDDO
147             ENDDO
148
149          CASE ( 'ql_vp' )
150             DO  i = nxl-1, nxr+1
151                DO  j = nys-1, nyn+1
152                   DO  k = nzb, nzt+1
153                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
154                                        REAL( average_count_3d )
155                   ENDDO
156                ENDDO
157             ENDDO
158
159          CASE ( 'qv' )
160             DO  i = nxl-1, nxr+1
161                DO  j = nys-1, nyn+1
162                   DO  k = nzb, nzt+1
163                      qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d )
164                   ENDDO
165                ENDDO
166             ENDDO
167             
168          CASE ( 's' )
169             DO  i = nxl-1, nxr+1
170                DO  j = nys-1, nyn+1
171                   DO  k = nzb, nzt+1
172                      s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d )
173                   ENDDO
174                ENDDO
175             ENDDO
176             
177          CASE ( 't*' )
178             DO  i = nxl-1, nxr+1
179                DO  j = nys-1, nyn+1
180                   ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d )
181                ENDDO
182             ENDDO
183
184          CASE ( 'u' )
185             DO  i = nxl-1, nxr+1
186                DO  j = nys-1, nyn+1
187                   DO  k = nzb, nzt+1
188                      u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d )
189                   ENDDO
190                ENDDO
191             ENDDO
192
193          CASE ( 'u*' )
194             DO  i = nxl-1, nxr+1
195                DO  j = nys-1, nyn+1
196                   us_av(j,i) = us_av(j,i) / REAL( average_count_3d )
197                ENDDO
198             ENDDO
199
200          CASE ( 'v' )
201             DO  i = nxl-1, nxr+1
202                DO  j = nys-1, nyn+1
203                   DO  k = nzb, nzt+1
204                      v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d )
205                   ENDDO
206                ENDDO
207             ENDDO
208
209          CASE ( 'vpt' )
210             DO  i = nxl-1, nxr+1
211                DO  j = nys-1, nyn+1
212                   DO  k = nzb, nzt+1
213                      vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d )
214                   ENDDO
215                ENDDO
216             ENDDO
217
218          CASE ( 'w' )
219             DO  i = nxl-1, nxr+1
220                DO  j = nys-1, nyn+1
221                   DO  k = nzb, nzt+1
222                      w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d )
223                   ENDDO
224                ENDDO
225             ENDDO
226
227          CASE ( 'z0*' )
228             DO  i = nxl-1, nxr+1
229                DO  j = nys-1, nyn+1
230                   z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d )
231                ENDDO
232             ENDDO
233
234          CASE DEFAULT
235!
236!--          User-defined quantity
237             CALL user_3d_data_averaging( 'average', doav(ii) )
238
239       END SELECT
240
241    ENDDO
242
243!
244!-- Reset the counter
245    average_count_3d = 0.0
246
247    CALL cpu_log (log_point(35),'average_3d_data','stop','nobarrier')
248
249
250 END SUBROUTINE average_3d_data
Note: See TracBrowser for help on using the repository browser.