source: palm/trunk/SOURCE/lpm.f90 @ 849

Last change on this file since 849 was 849, checked in by raasch, 12 years ago

Changed:


Original routine advec_particles split into several new subroutines and renamed
lpm.
init_particles renamed lpm_init
user_advec_particles renamed user_lpm_advec,
particle_boundary_conds renamed lpm_boundary_conds,
set_particle_attributes renamed lpm_set_attributes,
user_init_particles renamed user_lpm_init,
user_particle_attributes renamed user_lpm_set_attributes
(Makefile, lpm_droplet_collision, lpm_droplet_condensation, init_3d_model, modules, palm, read_var_list, time_integration, write_var_list, deleted: advec_particles, init_particles, particle_boundary_conds, set_particle_attributes, user_advec_particles, user_init_particles, user_particle_attributes, new: lpm, lpm_advec, lpm_boundary_conds, lpm_calc_liquid_water_content, lpm_data_output_particles, lpm_droplet_collision, lpm_drollet_condensation, lpm_exchange_horiz, lpm_extend_particle_array, lpm_extend_tails, lpm_extend_tail_array, lpm_init, lpm_init_sgs_tke, lpm_pack_arrays, lpm_read_restart_file, lpm_release_set, lpm_set_attributes, lpm_sort_arrays, lpm_write_exchange_statistics, lpm_write_restart_file, user_lpm_advec, user_lpm_init, user_lpm_set_attributes

  • Property svn:keywords set to Id
File size: 8.5 KB
RevLine 
[849]1 SUBROUTINE lpm
[1]2
3!------------------------------------------------------------------------------!
[230]4! Current revisions:
[759]5! ------------------
[849]6! Original routine advec_particles split into several subroutines and renamed
7! lpm
[829]8!
9! Former revisions:
10! -----------------
11! $Id: lpm.f90 849 2012-03-15 10:35:09Z raasch $
12!
[832]13! 831 2012-02-22 00:29:39Z raasch
14! thermal_conductivity_l and diff_coeff_l now depend on temperature and
15! pressure
16!
[829]17! 828 2012-02-21 12:00:36Z raasch
[828]18! fast hall/wang kernels with fixed radius/dissipation classes added,
19! particle feature color renamed class, routine colker renamed
20! recalculate_kernel,
21! lower limit for droplet radius changed from 1E-7 to 1E-8
[826]22!
[828]23! Bugfix: transformation factor for dissipation changed from 1E5 to 1E4
24!
[826]25! 825 2012-02-19 03:03:44Z raasch
[825]26! droplet growth by condensation may include curvature and solution effects,
27! initialisation of temporary particle array for resorting removed,
28! particle attributes speed_x|y|z_sgs renamed rvar1|2|3,
29! module wang_kernel_mod renamed lpm_collision_kernels_mod,
30! wang_collision_kernel renamed wang_kernel
[482]31!
[800]32! 799 2011-12-21 17:48:03Z franke
33! Implementation of Wang collision kernel and corresponding new parameter
34! wang_collision_kernel
35!
[799]36! 792 2011-12-01 raasch
37! particle arrays (particles, particles_temp) implemented as pointers in
38! order to speed up sorting (see routine sort_particles)
39!
[760]40! 759 2011-09-15 13:58:31Z raasch
41! Splitting of parallel I/O (routine write_particles)
42!
[1]43! Revision 1.1  1999/11/25 16:16:06  raasch
44! Initial revision
45!
46!
47! Description:
48! ------------
49! Particle advection
50!------------------------------------------------------------------------------!
51
52    USE arrays_3d
53    USE control_parameters
54    USE cpulog
55    USE interfaces
56    USE particle_attributes
57    USE pegrid
58    USE statistics
59
60    IMPLICIT NONE
61
[849]62    INTEGER ::  m
[1]63
[60]64
[849]65    CALL cpu_log( log_point(25), 'lpm', 'start' )
[824]66
[849]67!
68!-- Write particle data at current time on file.
69!-- This has to be done here, before particles are further processed,
70!-- because they may be deleted within this timestep (in case that
71!-- dt_write_particle_data = dt_prel = particle_maximum_age).
72    time_write_particle_data = time_write_particle_data + dt_3d
73    IF ( time_write_particle_data >= dt_write_particle_data )  THEN
[1]74
[849]75       CALL lpm_data_output_particles
[824]76!
[849]77!--    The MOD function allows for changes in the output interval with restart
78!--    runs.
79       time_write_particle_data = MOD( time_write_particle_data, &
80                                  MAX( dt_write_particle_data, dt_3d ) )
81    ENDIF
[1]82
[60]83
[849]84!
85!-- Initialize arrays for marking those particles/tails to be deleted after the
86!-- (sub-) timestep
87    particle_mask     = .TRUE.
88    deleted_particles = 0
[60]89
[849]90    IF ( use_particle_tails )  THEN
91       tail_mask = .TRUE.
92    ENDIF
93    deleted_tails = 0
[1]94
95
96!
[849]97!-- Initialize variables used for accumulating the number of particles
98!-- exchanged between the subdomains during all sub-timesteps (if sgs
99!-- velocities are included). These data are output further below on the
100!-- particle statistics file.
101    trlp_count_sum      = 0
102    trlp_count_recv_sum = 0
103    trrp_count_sum      = 0
104    trrp_count_recv_sum = 0
105    trsp_count_sum      = 0
106    trsp_count_recv_sum = 0
107    trnp_count_sum      = 0
108    trnp_count_recv_sum = 0
[1]109
110
111!
112!-- Calculate exponential term used in case of particle inertia for each
113!-- of the particle groups
114    DO  m = 1, number_of_particle_groups
115       IF ( particle_groups(m)%density_ratio /= 0.0 )  THEN
116          particle_groups(m)%exp_arg  =                                        &
117                    4.5 * particle_groups(m)%density_ratio *                   &
118                    molecular_viscosity / ( particle_groups(m)%radius )**2
119          particle_groups(m)%exp_term = EXP( -particle_groups(m)%exp_arg * &
120                                             dt_3d )
121       ENDIF
122    ENDDO
123
[849]124
[1]125!
126!-- Particle (droplet) growth by condensation/evaporation and collision
127    IF ( cloud_droplets )  THEN
128
129!
130!--    Reset summation arrays
131       ql_c = 0.0;  ql_v = 0.0;  ql_vp = 0.0
132
133!
[849]134!--    Droplet growth by condensation / evaporation
135       CALL lpm_droplet_condensation
[1]136
137!
138!--    Particle growth by collision
[849]139       IF ( collision_kernel /= 'none' )  CALL lpm_droplet_collision
[825]140
[849]141    ENDIF
[420]142
[1]143
144!
[849]145!-- If particle advection includes SGS velocity components, calculate the
146!-- required SGS quantities (i.e. gradients of the TKE, as well as horizontally
147!-- averaged profiles of the SGS TKE and the resolved-scale velocity variances)
148    IF ( use_sgs_for_particles )  CALL lpm_init_sgs_tke
[799]149
150
151!
[1]152!-- Initialize the variable storing the total time that a particle has advanced
153!-- within the timestep procedure
154    particles(1:number_of_particles)%dt_sum = 0.0
155
[849]156
[1]157!
[849]158!-- Timestep loop for particle advection.
[1]159!-- This loop has to be repeated until the advection time of every particle
[849]160!-- (within the total domain!) has reached the LES timestep (dt_3d).
161!-- In case of including the SGS velocities, the particle timestep may be
162!-- smaller than the LES timestep (because of the Lagrangian timescale restric-
163!-- tion) and particles may require to undergo several particle timesteps,
164!-- before the LES timestep is reached. Because the number of these particle
165!-- timesteps to be carried out is unknown at first, these steps are carried
166!-- out in the following infinite loop with exit condition.
[1]167    DO
168
[849]169       CALL cpu_log( log_point_s(44), 'lpm_advec', 'start' )
[1]170
171!
172!--    Initialize the switch used for the loop exit condition checked at the
173!--    end of this loop.
174!--    If at least one particle has failed to reach the LES timestep, this
175!--    switch will be set false.
176       dt_3d_reached_l = .TRUE.
177
178!
[849]179!--    Particle advection
180       CALL lpm_advec
[1]181
182!
[57]183!--    Particle reflection from walls
[849]184       CALL lpm_boundary_conds( 'walls' )
[57]185
186!
[212]187!--    User-defined actions after the calculation of the new particle position
[849]188       CALL user_lpm_advec
[57]189
190!
[1]191!--    Find out, if all particles on every PE have completed the LES timestep
192!--    and set the switch corespondingly
193#if defined( __parallel )
[622]194       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1]195       CALL MPI_ALLREDUCE( dt_3d_reached_l, dt_3d_reached, 1, MPI_LOGICAL, &
196                           MPI_LAND, comm2d, ierr )
197#else
198       dt_3d_reached = dt_3d_reached_l
[799]199#endif
[1]200
[849]201       CALL cpu_log( log_point_s(44), 'lpm_advec', 'stop' )
[1]202
203!
204!--    Increment time since last release
205       IF ( dt_3d_reached )  time_prel = time_prel + dt_3d
206
207!
208!--    If necessary, release new set of particles
209       IF ( time_prel >= dt_prel  .AND.  end_time_prel > simulated_time  .AND. &
210            dt_3d_reached )  THEN
211
[849]212          CALL lpm_release_set
[1]213
214!
215!--       The MOD function allows for changes in the output interval with
216!--       restart runs.
217          time_prel = MOD( time_prel, MAX( dt_prel, dt_3d ) )
218
219       ENDIF
220
221!
[849]222!--    Horizontal boundary conditions including exchange between subdmains
223       CALL lpm_exchange_horiz
[1]224
225!
226!--    Apply boundary conditions to those particles that have crossed the top or
227!--    bottom boundary and delete those particles, which are older than allowed
[849]228       CALL lpm_boundary_conds( 'bottom/top' )
[1]229
[57]230!
[1]231!--    Pack particles (eliminate those marked for deletion),
232!--    determine new number of particles
233       IF ( number_of_particles > 0  .AND.  deleted_particles > 0 )  THEN
[849]234          CALL lpm_pack_arrays
[1]235       ENDIF
236
237       IF ( dt_3d_reached )  EXIT
238
239    ENDDO   ! timestep loop
240
[849]241
[1]242!
[116]243!-- Sort particles in the sequence the gridboxes are stored in the memory
244    time_sort_particles = time_sort_particles + dt_3d
245    IF ( time_sort_particles >= dt_sort_particles )  THEN
[849]246       CALL lpm_sort_arrays
[116]247       time_sort_particles = MOD( time_sort_particles, &
248                                  MAX( dt_sort_particles, dt_3d ) )
249    ENDIF
250
[1]251
252!
[849]253!-- Calculate the new liquid water content for each grid box
254    IF ( cloud_droplets )  CALL lpm_calc_liquid_water_content
[1]255
256
257!
[828]258!-- Set particle attributes.
259!-- Feature is not available if collision is activated, because the respective
260!-- particle attribute (class) is then used for storing the particle radius
261!-- class.
[849]262    IF ( collision_kernel == 'none' )  CALL lpm_set_attributes
[264]263
[849]264
[264]265!
[1]266!-- Set particle attributes defined by the user
[849]267    CALL user_lpm_set_attributes
[1]268
269
270!
[849]271!-- If required, add the current particle positions to the particle tails
272    IF ( use_particle_tails )  CALL lpm_extend_tails
[1]273
274
275!
[849]276!-- Write particle statistics (in particular the number of particles
277!-- exchanged between the subdomains) on file
278    IF ( write_particle_statistics )  CALL lpm_write_exchange_statistics
[1]279
[849]280    CALL cpu_log( log_point(25), 'lpm', 'stop' )
[1]281
282
[849]283 END SUBROUTINE lpm
Note: See TracBrowser for help on using the repository browser.