source: palm/trunk/SOURCE/swap_timelevel.f90 @ 94

Last change on this file since 94 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: 5.7 KB
Line 
1 SUBROUTINE swap_timelevel
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: swap_timelevel.f90 77 2007-03-29 04:26:56Z raasch $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! moisture renamed humidity
14!
15! 19 2007-02-23 04:53:48Z raasch
16! Swaping of top fluxes
17!
18! RCS Log replace by Id keyword, revision history cleaned up
19!
20! Revision 1.8  2004/01/28 15:28:18  raasch
21! Swaping for Runge-Kutta schemes implemented
22!
23! Revision 1.1  2000/01/10  10:08:58  10:08:58  raasch (Siegfried Raasch)
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Swap of timelevels of variables after each timestep
30!------------------------------------------------------------------------------!
31
32    USE arrays_3d
33    USE cpulog
34    USE interfaces
35    USE control_parameters
36
37    IMPLICIT NONE
38
39
40    CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
41
42!
43!-- Incrementing timestep counter
44    timestep_count = timestep_count + 1
45
46!
47!-- Swap of 3-level variables
48    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
49
50       SELECT CASE ( MOD( timestep_count, 3 ) )
51
52          CASE ( 0 )
53
54             u_m  => u_1;   u  => u_2;  u_p  => u_3
55             v_m  => v_1;   v  => v_2;  v_p  => v_3
56             w_m  => w_1;   w  => w_2;  w_p  => w_3
57             pt_m => pt_1;  pt => pt_2; pt_p => pt_3
58             IF ( .NOT. constant_diffusion )  THEN
59                e_m => e_1;  e => e_2;  e_p => e_3
60             ENDIF
61             IF ( humidity  .OR.  passive_scalar )  THEN
62                q_m => q_1;  q => q_2;  q_p => q_3
63             ENDIF
64
65          CASE ( 1 )
66
67             u_m  => u_2;   u  => u_3;  u_p  => u_1
68             v_m  => v_2;   v  => v_3;  v_p  => v_1
69             w_m  => w_2;   w  => w_3;  w_p  => w_1
70             pt_m => pt_2;  pt => pt_3; pt_p => pt_1
71             IF ( .NOT. constant_diffusion )  THEN
72                e_m => e_2;  e => e_3;  e_p => e_1
73             ENDIF
74             IF ( humidity  .OR.  passive_scalar )  THEN
75                q_m => q_2;  q => q_3;  q_p => q_1
76             ENDIF
77
78          CASE ( 2 )
79
80             u_m  => u_3;   u  => u_1;  u_p  => u_2
81             v_m  => v_3;   v  => v_1;  v_p  => v_2
82             w_m  => w_3;   w  => w_1;  w_p  => w_2
83             pt_m => pt_3;  pt => pt_1; pt_p => pt_2
84             IF ( .NOT. constant_diffusion )  THEN
85                e_m => e_3;  e => e_1;  e_p => e_2
86             ENDIF
87             IF ( humidity  .OR.  passive_scalar )  THEN
88                q_m => q_3;  q => q_1;  q_p => q_2
89             ENDIF
90
91       END SELECT
92
93    ENDIF
94
95!
96!-- Swap of 2-level variables
97    SELECT CASE ( MOD( timestep_count, 2 ) )
98
99       CASE ( 0 )
100
101          IF ( timestep_scheme(1:5) == 'runge' )  THEN
102
103             u  => u_1;   u_p  => u_2
104             v  => v_1;   v_p  => v_2
105             w  => w_1;   w_p  => w_2
106             pt => pt_1;  pt_p => pt_2
107             IF ( .NOT. constant_diffusion )  THEN
108                e => e_1;  e_p => e_2
109             ENDIF
110             IF ( humidity  .OR.  passive_scalar )  THEN
111                q => q_1;  q_p => q_2
112             ENDIF
113
114          ELSE
115!
116!--          Old timelevels are needed for explicit diffusion within leapfrog
117             IF ( .NOT. constant_diffusion )  THEN
118                kh_m => kh_1;  kh => kh_2
119                km_m => km_1;  km => km_2
120                IF ( use_surface_fluxes )  THEN
121                   usws_m => usws_1;  usws => usws_2
122                   vsws_m => vsws_1;  vsws => vsws_2
123                   shf_m  => shf_1;   shf  => shf_2
124                   IF ( humidity  .OR.  passive_scalar )  THEN
125                      qsws_m => qsws_1;  qsws => qsws_2
126                   ENDIF
127                ENDIF
128                IF ( prandtl_layer )  THEN
129                   rif_m  => rif_1;   rif  => rif_2
130                ENDIF
131                IF ( use_top_fluxes )  THEN
132                   tswst_m => tswst_1;  tswst => tswst_2
133                   IF ( humidity  .OR.  passive_scalar )  THEN
134                      qswst_m => qswst_1;  qswst => qswst_2
135                   ENDIF
136                ENDIF
137             ENDIF
138
139             IF ( humidity )  THEN
140                vpt_m => vpt_1;  vpt => vpt_2
141             ENDIF
142
143          ENDIF
144
145       CASE ( 1 )
146
147          IF ( timestep_scheme(1:5) == 'runge' )  THEN
148
149             u  => u_2;   u_p  => u_1
150             v  => v_2;   v_p  => v_1
151             w  => w_2;   w_p  => w_1
152             pt => pt_2;  pt_p => pt_1
153             IF ( .NOT. constant_diffusion )  THEN
154                e => e_2;  e_p => e_1
155             ENDIF
156             IF ( humidity  .OR.  passive_scalar )  THEN
157                q => q_2;  q_p => q_1
158             ENDIF
159
160          ELSE
161
162             IF ( .NOT. constant_diffusion )  THEN
163                kh_m => kh_2;  kh => kh_1
164                km_m => km_2;  km => km_1
165                IF ( use_surface_fluxes )  THEN
166                   usws_m => usws_2;  usws => usws_1
167                   vsws_m => vsws_2;  vsws => vsws_1
168                   shf_m  => shf_2;   shf  => shf_1
169                   IF ( humidity  .OR.  passive_scalar )  THEN
170                      qsws_m => qsws_2;  qsws => qsws_1
171                   ENDIF
172                ENDIF
173                IF ( prandtl_layer )  THEN
174                   rif_m  => rif_2;   rif  => rif_1
175                ENDIF
176                IF ( use_top_fluxes )  THEN
177                   tswst_m  => tswst_2;  tswst => tswst_1
178                   IF ( humidity  .OR.  passive_scalar )  THEN
179                      qswst_m => qswst_2;  qswst => qswst_1
180                   ENDIF
181                ENDIF
182             ENDIF
183
184             IF ( humidity )  THEN
185                vpt_m => vpt_2;  vpt => vpt_1
186             ENDIF
187
188          ENDIF
189
190    END SELECT
191
192    CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
193
194 END SUBROUTINE swap_timelevel
195
196
Note: See TracBrowser for help on using the repository browser.