source: palm/trunk/SOURCE/lpm_advec.f90 @ 2008

Last change on this file since 2008 was 2001, checked in by knoop, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 72.9 KB
Line 
1!> @file lpm_advec.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2016 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: lpm_advec.f90 2001 2016-08-20 18:41:22Z kanani $
27!
28! 2000 2016-08-20 18:09:15Z knoop
29! Forced header and separation lines into 80 columns
30!
31! 1936 2016-06-13 13:37:44Z suehring
32! Formatting adjustments
33!
34! 1929 2016-06-09 16:25:25Z suehring
35! Put stochastic equation in an extra subroutine.
36! Set flag for stochastic equation to communicate whether a particle is near
37! topography. This case, memory and drift term are disabled in the Weil equation.
38!
39! Enable vertical logarithmic interpolation also above topography. This case,
40! set a lower limit for the friction velocity, as it can become very small
41! in narrow street canyons, leading to too large particle speeds.
42!
43! 1888 2016-04-21 12:20:49Z suehring
44! Bugfix concerning logarithmic interpolation of particle speed
45!
46! 1822 2016-04-07 07:49:42Z hoffmann
47! Random velocity fluctuations for particles added. Terminal fall velocity
48! for droplets is calculated from a parameterization (which is better than
49! the previous, physically correct calculation, which demands a very short
50! time step that is not used in the model).
51!
52! Unused variables deleted.
53!
54! 1691 2015-10-26 16:17:44Z maronga
55! Renamed prandtl_layer to constant_flux_layer.
56!
57! 1685 2015-10-08 07:32:13Z raasch
58! TKE check for negative values (so far, only zero value was checked)
59! offset_ocean_nzt_m1 removed
60!
61! 1682 2015-10-07 23:56:08Z knoop
62! Code annotations made doxygen readable
63!
64! 1583 2015-04-15 12:16:27Z suehring
65! Bugfix: particle advection within Prandtl-layer in case of Galilei
66! transformation.
67!
68! 1369 2014-04-24 05:57:38Z raasch
69! usage of module interfaces removed
70!
71! 1359 2014-04-11 17:15:14Z hoffmann
72! New particle structure integrated.
73! Kind definition added to all floating point numbers.
74!
75! 1322 2014-03-20 16:38:49Z raasch
76! REAL constants defined as wp_kind
77!
78! 1320 2014-03-20 08:40:49Z raasch
79! ONLY-attribute added to USE-statements,
80! kind-parameters added to all INTEGER and REAL declaration statements,
81! kinds are defined in new module kinds,
82! revision history before 2012 removed,
83! comment fields (!:) to be used for variable explanations added to
84! all variable declaration statements
85!
86! 1314 2014-03-14 18:25:17Z suehring
87! Vertical logarithmic interpolation of horizontal particle speed for particles
88! between roughness height and first vertical grid level.
89!
90! 1036 2012-10-22 13:43:42Z raasch
91! code put under GPL (PALM 3.9)
92!
93! 849 2012-03-15 10:35:09Z raasch
94! initial revision (former part of advec_particles)
95!
96!
97! Description:
98! ------------
99!> Calculation of new particle positions due to advection using a simple Euler
100!> scheme. Particles may feel inertia effects. SGS transport can be included
101!> using the stochastic model of Weil et al. (2004, JAS, 61, 2877-2887).
102!------------------------------------------------------------------------------!
103 SUBROUTINE lpm_advec (ip,jp,kp)
104 
105
106    USE arrays_3d,                                                             &
107        ONLY:  de_dx, de_dy, de_dz, diss, e, km, u, us, usws, v, vsws, w, zu, zw
108
109    USE cpulog
110
111    USE pegrid
112
113    USE control_parameters,                                                    &
114        ONLY:  atmos_ocean_sign, cloud_droplets, constant_flux_layer, dt_3d,   &
115               dt_3d_reached_l, dz, g, kappa, topography, u_gtrans, v_gtrans
116
117    USE grid_variables,                                                        &
118        ONLY:  ddx, dx, ddy, dy
119       
120    USE indices,                                                               &
121        ONLY:  nzb, nzb_s_inner, nzt
122       
123    USE kinds
124   
125    USE particle_attributes,                                                   &
126        ONLY:  block_offset, c_0, dt_min_part, grid_particles,                 &
127               iran_part, log_z_z0, number_of_particles, number_of_sublayers,  &
128               particles, particle_groups, offset_ocean_nzt, sgs_wf_part,      &
129               use_sgs_for_particles, vertical_particle_advection, z0_av_global
130       
131    USE statistics,                                                            &
132        ONLY:  hom
133
134    IMPLICIT NONE
135
136    INTEGER(iwp) ::  agp                         !< loop variable
137    INTEGER(iwp) ::  gp_outside_of_building(1:8) !< number of grid points used for particle interpolation in case of topography
138    INTEGER(iwp) ::  i                           !< index variable along x
139    INTEGER(iwp) ::  ip                          !< index variable along x
140    INTEGER(iwp) ::  ilog                        !< index variable along x
141    INTEGER(iwp) ::  j                           !< index variable along y
142    INTEGER(iwp) ::  jp                          !< index variable along y
143    INTEGER(iwp) ::  jlog                        !< index variable along y
144    INTEGER(iwp) ::  k                           !< index variable along z
145    INTEGER(iwp) ::  kp                          !< index variable along z
146    INTEGER(iwp) ::  kw                          !< index variable along z
147    INTEGER(iwp) ::  n                           !< loop variable over all particles in a grid box
148    INTEGER(iwp) ::  nb                          !< block number particles are sorted in
149    INTEGER(iwp) ::  num_gp                      !< number of adjacent grid points inside topography
150
151    INTEGER(iwp), DIMENSION(0:7) ::  start_index !< start particle index for current block
152    INTEGER(iwp), DIMENSION(0:7) ::  end_index   !< start particle index for current block
153
154    REAL(wp) ::  aa                 !< dummy argument for horizontal particle interpolation
155    REAL(wp) ::  bb                 !< dummy argument for horizontal particle interpolation
156    REAL(wp) ::  cc                 !< dummy argument for horizontal particle interpolation
157    REAL(wp) ::  d_sum              !< dummy argument for horizontal particle interpolation in case of topography
158    REAL(wp) ::  d_z_p_z0           !< inverse of interpolation length for logarithmic interpolation
159    REAL(wp) ::  dd                 !< dummy argument for horizontal particle interpolation
160    REAL(wp) ::  de_dx_int_l        !< x/y-interpolated TKE gradient (x) at particle position at lower vertical level
161    REAL(wp) ::  de_dx_int_u        !< x/y-interpolated TKE gradient (x) at particle position at upper vertical level
162    REAL(wp) ::  de_dy_int_l        !< x/y-interpolated TKE gradient (y) at particle position at lower vertical level
163    REAL(wp) ::  de_dy_int_u        !< x/y-interpolated TKE gradient (y) at particle position at upper vertical level
164    REAL(wp) ::  de_dt              !< temporal derivative of TKE experienced by the particle
165    REAL(wp) ::  de_dt_min          !< lower level for temporal TKE derivative
166    REAL(wp) ::  de_dz_int_l        !< x/y-interpolated TKE gradient (z) at particle position at lower vertical level
167    REAL(wp) ::  de_dz_int_u        !< x/y-interpolated TKE gradient (z) at particle position at upper vertical level
168    REAL(wp) ::  diameter           !< diamter of droplet
169    REAL(wp) ::  diss_int_l         !< x/y-interpolated dissipation at particle position at lower vertical level
170    REAL(wp) ::  diss_int_u         !< x/y-interpolated dissipation at particle position at upper vertical level
171    REAL(wp) ::  dt_gap             !< remaining time until particle time integration reaches LES time
172    REAL(wp) ::  dt_particle_m      !< previous particle time step
173    REAL(wp) ::  e_int_l            !< x/y-interpolated TKE at particle position at lower vertical level
174    REAL(wp) ::  e_int_u            !< x/y-interpolated TKE at particle position at upper vertical level
175    REAL(wp) ::  e_mean_int         !< horizontal mean TKE at particle height
176    REAL(wp) ::  exp_arg            !<
177    REAL(wp) ::  exp_term           !<
178    REAL(wp) ::  gg                 !< dummy argument for horizontal particle interpolation
179    REAL(wp) ::  height_p           !< dummy argument for logarithmic interpolation
180    REAL(wp) ::  lagr_timescale     !< Lagrangian timescale
181    REAL(wp) ::  location(1:30,1:3) !< wall locations
182    REAL(wp) ::  log_z_z0_int       !< logarithmus used for surface_layer interpolation
183    REAL(wp) ::  random_gauss       !<
184    REAL(wp) ::  RL                 !< Lagrangian autocorrelation coefficient
185    REAL(wp) ::  rg1                !< Gaussian distributed random number
186    REAL(wp) ::  rg2                !< Gaussian distributed random number
187    REAL(wp) ::  rg3                !< Gaussian distributed random number
188    REAL(wp) ::  sigma              !< velocity standard deviation
189    REAL(wp) ::  u_int_l            !< x/y-interpolated u-component at particle position at lower vertical level
190    REAL(wp) ::  u_int_u            !< x/y-interpolated u-component at particle position at upper vertical level
191    REAL(wp) ::  us_int             !< friction velocity at particle grid box
192    REAL(wp) ::  v_int_l            !< x/y-interpolated v-component at particle position at lower vertical level
193    REAL(wp) ::  v_int_u            !< x/y-interpolated v-component at particle position at upper vertical level
194    REAL(wp) ::  vv_int             !<
195    REAL(wp) ::  w_int_l            !< x/y-interpolated w-component at particle position at lower vertical level
196    REAL(wp) ::  w_int_u            !< x/y-interpolated w-component at particle position at upper vertical level
197    REAL(wp) ::  w_s                !< terminal velocity of droplets
198    REAL(wp) ::  x                  !< dummy argument for horizontal particle interpolation
199    REAL(wp) ::  y                  !< dummy argument for horizontal particle interpolation
200    REAL(wp) ::  z_p                !< surface layer height (0.5 dz)
201
202    REAL(wp), PARAMETER ::  a_rog = 9.65_wp      !< parameter for fall velocity
203    REAL(wp), PARAMETER ::  b_rog = 10.43_wp     !< parameter for fall velocity
204    REAL(wp), PARAMETER ::  c_rog = 0.6_wp       !< parameter for fall velocity
205    REAL(wp), PARAMETER ::  k_cap_rog = 4.0_wp   !< parameter for fall velocity
206    REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp  !< parameter for fall velocity
207    REAL(wp), PARAMETER ::  d0_rog = 0.745_wp    !< separation diameter
208
209    REAL(wp), DIMENSION(1:30) ::  d_gp_pl !< dummy argument for particle interpolation scheme in case of topography
210    REAL(wp), DIMENSION(1:30) ::  de_dxi  !< horizontal TKE gradient along x at adjacent wall
211    REAL(wp), DIMENSION(1:30) ::  de_dyi  !< horizontal TKE gradient along y at adjacent wall
212    REAL(wp), DIMENSION(1:30) ::  de_dzi  !< horizontal TKE gradient along z at adjacent wall
213    REAL(wp), DIMENSION(1:30) ::  dissi   !< dissipation at adjacent wall
214    REAL(wp), DIMENSION(1:30) ::  ei      !< TKE at adjacent wall
215
216    REAL(wp), DIMENSION(number_of_particles) ::  term_1_2     !< flag to communicate whether a particle is near topography or not
217    REAL(wp), DIMENSION(number_of_particles) ::  dens_ratio   !<
218    REAL(wp), DIMENSION(number_of_particles) ::  de_dx_int    !< horizontal TKE gradient along x at particle position
219    REAL(wp), DIMENSION(number_of_particles) ::  de_dy_int    !< horizontal TKE gradient along y at particle position
220    REAL(wp), DIMENSION(number_of_particles) ::  de_dz_int    !< horizontal TKE gradient along z at particle position
221    REAL(wp), DIMENSION(number_of_particles) ::  diss_int     !< dissipation at particle position
222    REAL(wp), DIMENSION(number_of_particles) ::  dt_particle  !< particle time step
223    REAL(wp), DIMENSION(number_of_particles) ::  e_int        !< TKE at particle position
224    REAL(wp), DIMENSION(number_of_particles) ::  fs_int       !< weighting factor for subgrid-scale particle speed
225    REAL(wp), DIMENSION(number_of_particles) ::  u_int        !< u-component of particle speed
226    REAL(wp), DIMENSION(number_of_particles) ::  v_int        !< v-component of particle speed
227    REAL(wp), DIMENSION(number_of_particles) ::  w_int        !< w-component of particle speed
228    REAL(wp), DIMENSION(number_of_particles) ::  xv           !< x-position
229    REAL(wp), DIMENSION(number_of_particles) ::  yv           !< y-position
230    REAL(wp), DIMENSION(number_of_particles) ::  zv           !< z-position
231
232    REAL(wp), DIMENSION(number_of_particles, 3) ::  rg !< vector of Gaussian distributed random numbers
233
234    CALL cpu_log( log_point_s(44), 'lpm_advec', 'continue' )
235
236!
237!-- Determine height of Prandtl layer and distance between Prandtl-layer
238!-- height and horizontal mean roughness height, which are required for
239!-- vertical logarithmic interpolation of horizontal particle speeds
240!-- (for particles below first vertical grid level).
241    z_p      = zu(nzb+1) - zw(nzb)
242    d_z_p_z0 = 1.0_wp / ( z_p - z0_av_global )
243
244    start_index = grid_particles(kp,jp,ip)%start_index
245    end_index   = grid_particles(kp,jp,ip)%end_index
246
247    xv = particles(1:number_of_particles)%x
248    yv = particles(1:number_of_particles)%y
249    zv = particles(1:number_of_particles)%z
250
251    DO  nb = 0, 7
252
253       i = ip
254       j = jp + block_offset(nb)%j_off
255       k = kp + block_offset(nb)%k_off
256
257
258!
259!--    Interpolate u velocity-component
260       DO  n = start_index(nb), end_index(nb)
261!
262!--       Interpolation of the u velocity component onto particle position. 
263!--       Particles are interpolation bi-linearly in the horizontal and a
264!--       linearly in the vertical. An exception is made for particles below
265!--       the first vertical grid level in case of a prandtl layer. In this
266!--       case the horizontal particle velocity components are determined using
267!--       Monin-Obukhov relations (if branch).
268!--       First, check if particle is located below first vertical grid level
269!--       (Prandtl-layer height)
270          ilog = ( particles(n)%x + 0.5_wp * dx ) * ddx
271          jlog = ( particles(n)%y + 0.5_wp * dy ) * ddy
272
273          IF ( constant_flux_layer  .AND.                                      &
274               zv(n) - zw(nzb_s_inner(jlog,ilog)) < z_p )  THEN
275!
276!--          Resolved-scale horizontal particle velocity is zero below z0.
277             IF ( zv(n) - zw(nzb_s_inner(jlog,ilog)) < z0_av_global )  THEN
278                u_int(n) = 0.0_wp
279             ELSE
280!
281!--             Determine the sublayer. Further used as index.
282                height_p = ( zv(n) - zw(nzb_s_inner(jlog,ilog)) - z0_av_global ) &
283                                     * REAL( number_of_sublayers, KIND=wp )    &
284                                     * d_z_p_z0 
285!
286!--             Calculate LOG(z/z0) for exact particle height. Therefore,   
287!--             interpolate linearly between precalculated logarithm.
288                log_z_z0_int = log_z_z0(INT(height_p))                         &
289                                 + ( height_p - INT(height_p) )                &
290                                 * ( log_z_z0(INT(height_p)+1)                 &
291                                      - log_z_z0(INT(height_p))                &
292                                   ) 
293!
294!--             Limit friction velocity. In narrow canyons or holes the
295!--             friction velocity can become very small, resulting in a too
296!--             large particle speed.
297                us_int   = MAX( 0.5_wp * ( us(jlog,ilog) + us(jlog,ilog-1) ),  &
298                                0.01_wp ) 
299!
300!--             Neutral solution is applied for all situations, e.g. also for
301!--             unstable and stable situations. Even though this is not exact
302!--             this saves a lot of CPU time since several calls of intrinsic
303!--             FORTRAN procedures (LOG, ATAN) are avoided, This is justified
304!--             as sensitivity studies revealed no significant effect of
305!--             using the neutral solution also for un/stable situations.
306                u_int(n) = -usws(jlog,ilog) / ( us_int * kappa + 1E-10_wp )          & 
307                            * log_z_z0_int - u_gtrans
308               
309             ENDIF
310!
311!--       Particle above the first grid level. Bi-linear interpolation in the
312!--       horizontal and linear interpolation in the vertical direction.
313          ELSE
314
315             x  = xv(n) + ( 0.5_wp - i ) * dx
316             y  = yv(n) - j * dy
317             aa = x**2          + y**2
318             bb = ( dx - x )**2 + y**2
319             cc = x**2          + ( dy - y )**2
320             dd = ( dx - x )**2 + ( dy - y )**2
321             gg = aa + bb + cc + dd
322
323             u_int_l = ( ( gg - aa ) * u(k,j,i)   + ( gg - bb ) * u(k,j,i+1)   &
324                         + ( gg - cc ) * u(k,j+1,i) + ( gg - dd ) *            &
325                         u(k,j+1,i+1) ) / ( 3.0_wp * gg ) - u_gtrans
326
327             IF ( k == nzt )  THEN
328                u_int(n) = u_int_l
329             ELSE
330                u_int_u = ( ( gg-aa ) * u(k+1,j,i) + ( gg-bb ) * u(k+1,j,i+1)  &
331                            + ( gg-cc ) * u(k+1,j+1,i) + ( gg-dd ) *           &
332                            u(k+1,j+1,i+1) ) / ( 3.0_wp * gg ) - u_gtrans
333                u_int(n) = u_int_l + ( zv(n) - zu(k) ) / dz *                  &
334                           ( u_int_u - u_int_l )
335             ENDIF
336
337          ENDIF
338
339       ENDDO
340
341       i = ip + block_offset(nb)%i_off
342       j = jp
343       k = kp + block_offset(nb)%k_off
344!
345!--    Same procedure for interpolation of the v velocity-component
346       DO  n = start_index(nb), end_index(nb)
347
348          ilog = ( particles(n)%x + 0.5_wp * dx ) * ddx
349          jlog = ( particles(n)%y + 0.5_wp * dy ) * ddy
350          IF ( constant_flux_layer  .AND.                                      &
351               zv(n) - zw(nzb_s_inner(jlog,ilog)) < z_p )  THEN
352
353             IF ( zv(n) - zw(nzb_s_inner(jlog,ilog)) < z0_av_global )  THEN
354!
355!--             Resolved-scale horizontal particle velocity is zero below z0.
356                v_int(n) = 0.0_wp
357             ELSE       
358!
359!--             Determine the sublayer. Further used as index. Please note,
360!--             logarithmus can not be reused from above, as in in case of
361!--             topography particle on u-grid can be above surface-layer height,
362!--             whereas it can be below on v-grid.
363                height_p = ( zv(n) - zw(nzb_s_inner(jlog,ilog)) - z0_av_global ) &
364                                  * REAL( number_of_sublayers, KIND=wp )       &
365                                  * d_z_p_z0 
366!
367!--             Calculate LOG(z/z0) for exact particle height. Therefore,   
368!--             interpolate linearly between precalculated logarithm.
369                log_z_z0_int = log_z_z0(INT(height_p))                         &
370                                 + ( height_p - INT(height_p) )                &
371                                 * ( log_z_z0(INT(height_p)+1)                 &
372                                      - log_z_z0(INT(height_p))                &
373                                   ) 
374!
375!--             Limit friction velocity. In narrow canyons or holes the
376!--             friction velocity can become very small, resulting in a too
377!--             large particle speed.
378                us_int   = MAX( 0.5_wp * ( us(jlog,ilog) + us(jlog-1,ilog) ),  &
379                                0.01_wp )   
380!
381!--             Neutral solution is applied for all situations, e.g. also for
382!--             unstable and stable situations. Even though this is not exact
383!--             this saves a lot of CPU time since several calls of intrinsic
384!--             FORTRAN procedures (LOG, ATAN) are avoided, This is justified
385!--             as sensitivity studies revealed no significant effect of
386!--             using the neutral solution also for un/stable situations.
387                v_int(n) = -vsws(jlog,ilog) / ( us_int * kappa + 1E-10_wp )    &
388                         * log_z_z0_int - v_gtrans
389
390             ENDIF
391
392          ELSE
393             x  = xv(n) - i * dx
394             y  = yv(n) + ( 0.5_wp - j ) * dy
395             aa = x**2          + y**2
396             bb = ( dx - x )**2 + y**2
397             cc = x**2          + ( dy - y )**2
398             dd = ( dx - x )**2 + ( dy - y )**2
399             gg = aa + bb + cc + dd
400
401             v_int_l = ( ( gg - aa ) * v(k,j,i)   + ( gg - bb ) * v(k,j,i+1)   &
402                       + ( gg - cc ) * v(k,j+1,i) + ( gg - dd ) * v(k,j+1,i+1) &
403                       ) / ( 3.0_wp * gg ) - v_gtrans
404
405             IF ( k == nzt )  THEN
406                v_int(n) = v_int_l
407             ELSE
408                v_int_u = ( ( gg-aa ) * v(k+1,j,i)   + ( gg-bb ) * v(k+1,j,i+1)   &
409                          + ( gg-cc ) * v(k+1,j+1,i) + ( gg-dd ) * v(k+1,j+1,i+1) &
410                          ) / ( 3.0_wp * gg ) - v_gtrans
411                v_int(n) = v_int_l + ( zv(n) - zu(k) ) / dz * &
412                                  ( v_int_u - v_int_l )
413             ENDIF
414
415          ENDIF
416
417       ENDDO
418
419       i = ip + block_offset(nb)%i_off
420       j = jp + block_offset(nb)%j_off
421       k = kp - 1
422!
423!--    Same procedure for interpolation of the w velocity-component
424       DO  n = start_index(nb), end_index(nb)
425
426          IF ( vertical_particle_advection(particles(n)%group) )  THEN
427
428             x  = xv(n) - i * dx
429             y  = yv(n) - j * dy
430             aa = x**2          + y**2
431             bb = ( dx - x )**2 + y**2
432             cc = x**2          + ( dy - y )**2
433             dd = ( dx - x )**2 + ( dy - y )**2
434             gg = aa + bb + cc + dd
435
436             w_int_l = ( ( gg - aa ) * w(k,j,i)   + ( gg - bb ) * w(k,j,i+1)   &
437                       + ( gg - cc ) * w(k,j+1,i) + ( gg - dd ) * w(k,j+1,i+1) &
438                       ) / ( 3.0_wp * gg )
439
440             IF ( k == nzt )  THEN
441                w_int(n) = w_int_l
442             ELSE
443                w_int_u = ( ( gg-aa ) * w(k+1,j,i)   + &
444                            ( gg-bb ) * w(k+1,j,i+1) + &
445                            ( gg-cc ) * w(k+1,j+1,i) + &
446                            ( gg-dd ) * w(k+1,j+1,i+1) &
447                          ) / ( 3.0_wp * gg )
448                w_int(n) = w_int_l + ( zv(n) - zw(k) ) / dz * &
449                           ( w_int_u - w_int_l )
450             ENDIF
451
452          ELSE
453
454             w_int(n) = 0.0_wp
455
456          ENDIF
457
458       ENDDO
459
460    ENDDO
461
462!-- Interpolate and calculate quantities needed for calculating the SGS
463!-- velocities
464    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
465
466       IF ( topography == 'flat' )  THEN
467
468          DO  nb = 0,7
469
470             i = ip + block_offset(nb)%i_off
471             j = jp + block_offset(nb)%j_off
472             k = kp + block_offset(nb)%k_off
473
474             DO  n = start_index(nb), end_index(nb)
475!
476!--             Interpolate TKE
477                x  = xv(n) - i * dx
478                y  = yv(n) - j * dy
479                aa = x**2          + y**2
480                bb = ( dx - x )**2 + y**2
481                cc = x**2          + ( dy - y )**2
482                dd = ( dx - x )**2 + ( dy - y )**2
483                gg = aa + bb + cc + dd
484
485                e_int_l = ( ( gg-aa ) * e(k,j,i)   + ( gg-bb ) * e(k,j,i+1)   &
486                          + ( gg-cc ) * e(k,j+1,i) + ( gg-dd ) * e(k,j+1,i+1) &
487                          ) / ( 3.0_wp * gg )
488
489                IF ( k+1 == nzt+1 )  THEN
490                   e_int(n) = e_int_l
491                ELSE
492                   e_int_u = ( ( gg - aa ) * e(k+1,j,i)   + &
493                               ( gg - bb ) * e(k+1,j,i+1) + &
494                               ( gg - cc ) * e(k+1,j+1,i) + &
495                               ( gg - dd ) * e(k+1,j+1,i+1) &
496                            ) / ( 3.0_wp * gg )
497                   e_int(n) = e_int_l + ( zv(n) - zu(k) ) / dz * &
498                                     ( e_int_u - e_int_l )
499                ENDIF
500!
501!--             Needed to avoid NaN particle velocities (this might not be
502!--             required any more)
503                IF ( e_int(n) <= 0.0_wp )  THEN
504                   e_int(n) = 1.0E-20_wp
505                ENDIF
506!
507!--             Interpolate the TKE gradient along x (adopt incides i,j,k and
508!--             all position variables from above (TKE))
509                de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i)   + &
510                                ( gg - bb ) * de_dx(k,j,i+1) + &
511                                ( gg - cc ) * de_dx(k,j+1,i) + &
512                                ( gg - dd ) * de_dx(k,j+1,i+1) &
513                               ) / ( 3.0_wp * gg )
514
515                IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
516                   de_dx_int(n) = de_dx_int_l
517                ELSE
518                   de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i)   + &
519                                   ( gg - bb ) * de_dx(k+1,j,i+1) + &
520                                   ( gg - cc ) * de_dx(k+1,j+1,i) + &
521                                   ( gg - dd ) * de_dx(k+1,j+1,i+1) &
522                                  ) / ( 3.0_wp * gg )
523                   de_dx_int(n) = de_dx_int_l + ( zv(n) - zu(k) ) / dz * &
524                                              ( de_dx_int_u - de_dx_int_l )
525                ENDIF
526!
527!--             Interpolate the TKE gradient along y
528                de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i)   + &
529                                ( gg - bb ) * de_dy(k,j,i+1) + &
530                                ( gg - cc ) * de_dy(k,j+1,i) + &
531                                ( gg - dd ) * de_dy(k,j+1,i+1) &
532                               ) / ( 3.0_wp * gg )
533                IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
534                   de_dy_int(n) = de_dy_int_l
535                ELSE
536                   de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i)   + &
537                                  ( gg - bb ) * de_dy(k+1,j,i+1) + &
538                                  ( gg - cc ) * de_dy(k+1,j+1,i) + &
539                                  ( gg - dd ) * de_dy(k+1,j+1,i+1) &
540                                  ) / ( 3.0_wp * gg )
541                   de_dy_int(n) = de_dy_int_l + ( zv(n) - zu(k) ) / dz * &
542                                              ( de_dy_int_u - de_dy_int_l )
543                ENDIF
544
545!
546!--             Interpolate the TKE gradient along z
547                IF ( zv(n) < 0.5_wp * dz )  THEN
548                   de_dz_int(n) = 0.0_wp
549                ELSE
550                   de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i)   + &
551                                   ( gg - bb ) * de_dz(k,j,i+1) + &
552                                   ( gg - cc ) * de_dz(k,j+1,i) + &
553                                   ( gg - dd ) * de_dz(k,j+1,i+1) &
554                                  ) / ( 3.0_wp * gg )
555
556                   IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
557                      de_dz_int(n) = de_dz_int_l
558                   ELSE
559                      de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i)   + &
560                                      ( gg - bb ) * de_dz(k+1,j,i+1) + &
561                                      ( gg - cc ) * de_dz(k+1,j+1,i) + &
562                                      ( gg - dd ) * de_dz(k+1,j+1,i+1) &
563                                     ) / ( 3.0_wp * gg )
564                      de_dz_int(n) = de_dz_int_l + ( zv(n) - zu(k) ) / dz * &
565                                                 ( de_dz_int_u - de_dz_int_l )
566                   ENDIF
567                ENDIF
568
569!
570!--             Interpolate the dissipation of TKE
571                diss_int_l = ( ( gg - aa ) * diss(k,j,i)   + &
572                               ( gg - bb ) * diss(k,j,i+1) + &
573                               ( gg - cc ) * diss(k,j+1,i) + &
574                               ( gg - dd ) * diss(k,j+1,i+1) &
575                              ) / ( 3.0_wp * gg )
576
577                IF ( k == nzt )  THEN
578                   diss_int(n) = diss_int_l
579                ELSE
580                   diss_int_u = ( ( gg - aa ) * diss(k+1,j,i)   + &
581                                  ( gg - bb ) * diss(k+1,j,i+1) + &
582                                  ( gg - cc ) * diss(k+1,j+1,i) + &
583                                  ( gg - dd ) * diss(k+1,j+1,i+1) &
584                                 ) / ( 3.0_wp * gg )
585                   diss_int(n) = diss_int_l + ( zv(n) - zu(k) ) / dz * &
586                                           ( diss_int_u - diss_int_l )
587                ENDIF
588
589!
590!--             Set flag for stochastic equation.
591                term_1_2(n) = 1.0_wp
592
593             ENDDO
594          ENDDO
595
596       ELSE ! non-flat topography, e.g., buildings
597
598          DO  n = 1, number_of_particles
599             i = particles(n)%x * ddx
600             j = particles(n)%y * ddy
601             k = ( zv(n) + 0.5_wp * dz * atmos_ocean_sign ) / dz  &
602                 + offset_ocean_nzt                      ! only exact if eq.dist
603!
604!--          In case that there are buildings it has to be determined
605!--          how many of the gridpoints defining the particle box are
606!--          situated within a building
607!--          gp_outside_of_building(1): i,j,k
608!--          gp_outside_of_building(2): i,j+1,k
609!--          gp_outside_of_building(3): i,j,k+1
610!--          gp_outside_of_building(4): i,j+1,k+1
611!--          gp_outside_of_building(5): i+1,j,k
612!--          gp_outside_of_building(6): i+1,j+1,k
613!--          gp_outside_of_building(7): i+1,j,k+1
614!--          gp_outside_of_building(8): i+1,j+1,k+1
615
616             gp_outside_of_building = 0
617             location = 0.0_wp
618             num_gp = 0
619
620             IF ( k > nzb_s_inner(j,i)  .OR.  nzb_s_inner(j,i) == 0 )  THEN
621                num_gp = num_gp + 1
622                gp_outside_of_building(1) = 1
623                location(num_gp,1) = i * dx
624                location(num_gp,2) = j * dy
625                location(num_gp,3) = k * dz - 0.5_wp * dz
626                ei(num_gp)     = e(k,j,i)
627                dissi(num_gp)  = diss(k,j,i)
628                de_dxi(num_gp) = de_dx(k,j,i)
629                de_dyi(num_gp) = de_dy(k,j,i)
630                de_dzi(num_gp) = de_dz(k,j,i)
631             ENDIF
632             IF ( k > nzb_s_inner(j+1,i)  .OR.  nzb_s_inner(j+1,i) == 0 )  THEN
633                num_gp = num_gp + 1
634                gp_outside_of_building(2) = 1
635                location(num_gp,1) = i * dx
636                location(num_gp,2) = (j+1) * dy
637                location(num_gp,3) = k * dz - 0.5_wp * dz
638                ei(num_gp)     = e(k,j+1,i)
639                dissi(num_gp)  = diss(k,j+1,i)
640                de_dxi(num_gp) = de_dx(k,j+1,i)
641                de_dyi(num_gp) = de_dy(k,j+1,i)
642                de_dzi(num_gp) = de_dz(k,j+1,i)
643             ENDIF
644
645             IF ( k+1 > nzb_s_inner(j,i)  .OR.  nzb_s_inner(j,i) == 0 )  THEN
646                num_gp = num_gp + 1
647                gp_outside_of_building(3) = 1
648                location(num_gp,1) = i * dx
649                location(num_gp,2) = j * dy
650                location(num_gp,3) = (k+1) * dz - 0.5_wp * dz
651                ei(num_gp)     = e(k+1,j,i)
652                dissi(num_gp)  = diss(k+1,j,i)
653                de_dxi(num_gp) = de_dx(k+1,j,i)
654                de_dyi(num_gp) = de_dy(k+1,j,i)
655                de_dzi(num_gp) = de_dz(k+1,j,i)
656             ENDIF
657
658             IF ( k+1 > nzb_s_inner(j+1,i)  .OR.  nzb_s_inner(j+1,i) == 0 )  THEN
659                num_gp = num_gp + 1
660                gp_outside_of_building(4) = 1
661                location(num_gp,1) = i * dx
662                location(num_gp,2) = (j+1) * dy
663                location(num_gp,3) = (k+1) * dz - 0.5_wp * dz
664                ei(num_gp)     = e(k+1,j+1,i)
665                dissi(num_gp)  = diss(k+1,j+1,i)
666                de_dxi(num_gp) = de_dx(k+1,j+1,i)
667                de_dyi(num_gp) = de_dy(k+1,j+1,i)
668                de_dzi(num_gp) = de_dz(k+1,j+1,i)
669             ENDIF
670
671             IF ( k > nzb_s_inner(j,i+1)  .OR.  nzb_s_inner(j,i+1) == 0 )  THEN
672                num_gp = num_gp + 1
673                gp_outside_of_building(5) = 1
674                location(num_gp,1) = (i+1) * dx
675                location(num_gp,2) = j * dy
676                location(num_gp,3) = k * dz - 0.5_wp * dz
677                ei(num_gp)     = e(k,j,i+1)
678                dissi(num_gp)  = diss(k,j,i+1)
679                de_dxi(num_gp) = de_dx(k,j,i+1)
680                de_dyi(num_gp) = de_dy(k,j,i+1)
681                de_dzi(num_gp) = de_dz(k,j,i+1)
682             ENDIF
683
684             IF ( k > nzb_s_inner(j+1,i+1)  .OR.  nzb_s_inner(j+1,i+1) == 0 )  THEN
685                num_gp = num_gp + 1
686                gp_outside_of_building(6) = 1
687                location(num_gp,1) = (i+1) * dx
688                location(num_gp,2) = (j+1) * dy
689                location(num_gp,3) = k * dz - 0.5_wp * dz
690                ei(num_gp)     = e(k,j+1,i+1)
691                dissi(num_gp)  = diss(k,j+1,i+1)
692                de_dxi(num_gp) = de_dx(k,j+1,i+1)
693                de_dyi(num_gp) = de_dy(k,j+1,i+1)
694                de_dzi(num_gp) = de_dz(k,j+1,i+1)
695             ENDIF
696
697             IF ( k+1 > nzb_s_inner(j,i+1)  .OR.  nzb_s_inner(j,i+1) == 0 )  THEN
698                num_gp = num_gp + 1
699                gp_outside_of_building(7) = 1
700                location(num_gp,1) = (i+1) * dx
701                location(num_gp,2) = j * dy
702                location(num_gp,3) = (k+1) * dz - 0.5_wp * dz
703                ei(num_gp)     = e(k+1,j,i+1)
704                dissi(num_gp)  = diss(k+1,j,i+1)
705                de_dxi(num_gp) = de_dx(k+1,j,i+1)
706                de_dyi(num_gp) = de_dy(k+1,j,i+1)
707                de_dzi(num_gp) = de_dz(k+1,j,i+1)
708             ENDIF
709
710             IF ( k+1 > nzb_s_inner(j+1,i+1)  .OR.  nzb_s_inner(j+1,i+1) == 0)  THEN
711                num_gp = num_gp + 1
712                gp_outside_of_building(8) = 1
713                location(num_gp,1) = (i+1) * dx
714                location(num_gp,2) = (j+1) * dy
715                location(num_gp,3) = (k+1) * dz - 0.5_wp * dz
716                ei(num_gp)     = e(k+1,j+1,i+1)
717                dissi(num_gp)  = diss(k+1,j+1,i+1)
718                de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
719                de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
720                de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
721             ENDIF
722!
723!--          If all gridpoints are situated outside of a building, then the
724!--          ordinary interpolation scheme can be used.
725             IF ( num_gp == 8 )  THEN
726
727                x  = particles(n)%x - i * dx
728                y  = particles(n)%y - j * dy
729                aa = x**2          + y**2
730                bb = ( dx - x )**2 + y**2
731                cc = x**2          + ( dy - y )**2
732                dd = ( dx - x )**2 + ( dy - y )**2
733                gg = aa + bb + cc + dd
734 
735                e_int_l = ( ( gg - aa ) * e(k,j,i)   + ( gg - bb ) * e(k,j,i+1)   &
736                          + ( gg - cc ) * e(k,j+1,i) + ( gg - dd ) * e(k,j+1,i+1) &
737                          ) / ( 3.0_wp * gg )
738   
739                IF ( k == nzt )  THEN
740                   e_int(n) = e_int_l
741                ELSE
742                   e_int_u = ( ( gg - aa ) * e(k+1,j,i)   + &
743                               ( gg - bb ) * e(k+1,j,i+1) + &
744                               ( gg - cc ) * e(k+1,j+1,i) + &
745                               ( gg - dd ) * e(k+1,j+1,i+1) &
746                             ) / ( 3.0_wp * gg )
747                   e_int(n) = e_int_l + ( zv(n) - zu(k) ) / dz * &
748                                       ( e_int_u - e_int_l )
749                ENDIF
750!
751!--             Needed to avoid NaN particle velocities (this might not be
752!--             required any more)
753                IF ( e_int(n) <= 0.0_wp )  THEN
754                   e_int(n) = 1.0E-20_wp
755                ENDIF
756!
757!--             Interpolate the TKE gradient along x (adopt incides i,j,k
758!--             and all position variables from above (TKE))
759                de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i)   + &
760                                ( gg - bb ) * de_dx(k,j,i+1) + &
761                                ( gg - cc ) * de_dx(k,j+1,i) + &
762                                ( gg - dd ) * de_dx(k,j+1,i+1) &
763                              ) / ( 3.0_wp * gg )
764
765                IF ( ( k == nzt )  .OR.  ( k == nzb ) )  THEN
766                   de_dx_int(n) = de_dx_int_l
767                ELSE
768                   de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i)   + &
769                                   ( gg - bb ) * de_dx(k+1,j,i+1) + &
770                                   ( gg - cc ) * de_dx(k+1,j+1,i) + &
771                                   ( gg - dd ) * de_dx(k+1,j+1,i+1) &
772                                 ) / ( 3.0_wp * gg )
773                   de_dx_int(n) = de_dx_int_l + ( zv(n) - zu(k) ) / &
774                                           dz * ( de_dx_int_u - de_dx_int_l )
775                ENDIF
776
777!
778!--             Interpolate the TKE gradient along y
779                de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i)   + &
780                                ( gg - bb ) * de_dy(k,j,i+1) + &
781                                ( gg - cc ) * de_dy(k,j+1,i) + &
782                                ( gg - dd ) * de_dy(k,j+1,i+1) &
783                              ) / ( 3.0_wp * gg )
784                IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
785                   de_dy_int(n) = de_dy_int_l
786                ELSE
787                   de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i)   + &
788                                   ( gg - bb ) * de_dy(k+1,j,i+1) + &
789                                   ( gg - cc ) * de_dy(k+1,j+1,i) + &
790                                   ( gg - dd ) * de_dy(k+1,j+1,i+1) &
791                                 ) / ( 3.0_wp * gg )
792                   de_dy_int(n) = de_dy_int_l + ( zv(n) - zu(k) ) / &
793                                           dz * ( de_dy_int_u - de_dy_int_l )
794                ENDIF
795
796!
797!--             Interpolate the TKE gradient along z
798                IF ( zv(n) < 0.5_wp * dz )  THEN
799                   de_dz_int(n) = 0.0_wp
800                ELSE
801                   de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i)   + &
802                                   ( gg - bb ) * de_dz(k,j,i+1) + &
803                                   ( gg - cc ) * de_dz(k,j+1,i) + &
804                                   ( gg - dd ) * de_dz(k,j+1,i+1) &
805                                 ) / ( 3.0_wp * gg )
806 
807                   IF ( ( k+1 == nzt+1 )  .OR.  ( k == nzb ) )  THEN
808                      de_dz_int(n) = de_dz_int_l
809                   ELSE
810                      de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i)   + &
811                                      ( gg - bb ) * de_dz(k+1,j,i+1) + &
812                                      ( gg - cc ) * de_dz(k+1,j+1,i) + &
813                                      ( gg - dd ) * de_dz(k+1,j+1,i+1) &
814                                    ) / ( 3.0_wp * gg )
815                      de_dz_int(n) = de_dz_int_l + ( zv(n) - zu(k) ) /&
816                                           dz * ( de_dz_int_u - de_dz_int_l )
817                   ENDIF
818                ENDIF
819
820!
821!--             Interpolate the dissipation of TKE
822                diss_int_l = ( ( gg - aa ) * diss(k,j,i)   + &
823                               ( gg - bb ) * diss(k,j,i+1) + &
824                               ( gg - cc ) * diss(k,j+1,i) + &
825                               ( gg - dd ) * diss(k,j+1,i+1) &
826                             ) / ( 3.0_wp * gg )
827 
828                IF ( k == nzt )  THEN
829                   diss_int(n) = diss_int_l
830                ELSE
831                   diss_int_u = ( ( gg - aa ) * diss(k+1,j,i)   + &
832                                  ( gg - bb ) * diss(k+1,j,i+1) + &
833                                  ( gg - cc ) * diss(k+1,j+1,i) + &
834                                  ( gg - dd ) * diss(k+1,j+1,i+1) &
835                                ) / ( 3.0_wp * gg )
836                   diss_int(n) = diss_int_l + ( zv(n) - zu(k) ) / dz *&
837                                           ( diss_int_u - diss_int_l )
838                ENDIF
839!
840!--             Set flag for stochastic equation.
841                term_1_2(n) = 1.0_wp
842 
843             ELSE
844 
845!
846!--             If wall between gridpoint 1 and gridpoint 5, then
847!--             Neumann boundary condition has to be applied
848                IF ( gp_outside_of_building(1) == 1  .AND. &
849                     gp_outside_of_building(5) == 0 )  THEN
850                   num_gp = num_gp + 1
851                   location(num_gp,1) = i * dx + 0.5_wp * dx
852                   location(num_gp,2) = j * dy
853                   location(num_gp,3) = k * dz - 0.5_wp * dz
854                   ei(num_gp)     = e(k,j,i)
855                   dissi(num_gp)  = diss(k,j,i)
856                   de_dxi(num_gp) = 0.0_wp
857                   de_dyi(num_gp) = de_dy(k,j,i)
858                   de_dzi(num_gp) = de_dz(k,j,i)
859                ENDIF
860
861                IF ( gp_outside_of_building(5) == 1  .AND. &
862                     gp_outside_of_building(1) == 0 )  THEN
863                   num_gp = num_gp + 1
864                   location(num_gp,1) = i * dx + 0.5_wp * dx
865                   location(num_gp,2) = j * dy
866                   location(num_gp,3) = k * dz - 0.5_wp * dz
867                   ei(num_gp)     = e(k,j,i+1)
868                   dissi(num_gp)  = diss(k,j,i+1)
869                   de_dxi(num_gp) = 0.0_wp
870                   de_dyi(num_gp) = de_dy(k,j,i+1)
871                   de_dzi(num_gp) = de_dz(k,j,i+1)
872                ENDIF
873
874!
875!--             If wall between gridpoint 5 and gridpoint 6, then
876!--             then Neumann boundary condition has to be applied
877                IF ( gp_outside_of_building(5) == 1  .AND. &
878                     gp_outside_of_building(6) == 0 )  THEN
879                   num_gp = num_gp + 1
880                   location(num_gp,1) = (i+1) * dx
881                   location(num_gp,2) = j * dy + 0.5_wp * dy
882                   location(num_gp,3) = k * dz - 0.5_wp * dz
883                   ei(num_gp)     = e(k,j,i+1)
884                   dissi(num_gp)  = diss(k,j,i+1)
885                   de_dxi(num_gp) = de_dx(k,j,i+1)
886                   de_dyi(num_gp) = 0.0_wp
887                   de_dzi(num_gp) = de_dz(k,j,i+1)
888                ENDIF
889
890                IF ( gp_outside_of_building(6) == 1  .AND. &
891                     gp_outside_of_building(5) == 0 )  THEN
892                   num_gp = num_gp + 1
893                   location(num_gp,1) = (i+1) * dx
894                   location(num_gp,2) = j * dy + 0.5_wp * dy
895                   location(num_gp,3) = k * dz - 0.5_wp * dz
896                   ei(num_gp)     = e(k,j+1,i+1)
897                   dissi(num_gp)  = diss(k,j+1,i+1)
898                   de_dxi(num_gp) = de_dx(k,j+1,i+1)
899                   de_dyi(num_gp) = 0.0_wp
900                   de_dzi(num_gp) = de_dz(k,j+1,i+1)
901                ENDIF
902
903!
904!--             If wall between gridpoint 2 and gridpoint 6, then
905!--             Neumann boundary condition has to be applied
906                IF ( gp_outside_of_building(2) == 1  .AND. &
907                     gp_outside_of_building(6) == 0 )  THEN
908                   num_gp = num_gp + 1
909                   location(num_gp,1) = i * dx + 0.5_wp * dx
910                   location(num_gp,2) = (j+1) * dy
911                   location(num_gp,3) = k * dz - 0.5_wp * dz
912                   ei(num_gp)     = e(k,j+1,i)
913                   dissi(num_gp)  = diss(k,j+1,i)
914                   de_dxi(num_gp) = 0.0_wp
915                   de_dyi(num_gp) = de_dy(k,j+1,i)
916                   de_dzi(num_gp) = de_dz(k,j+1,i)
917                ENDIF
918
919                IF ( gp_outside_of_building(6) == 1  .AND. &
920                     gp_outside_of_building(2) == 0 )  THEN
921                   num_gp = num_gp + 1
922                   location(num_gp,1) = i * dx + 0.5_wp * dx
923                   location(num_gp,2) = (j+1) * dy
924                   location(num_gp,3) = k * dz - 0.5_wp * dz
925                   ei(num_gp)     = e(k,j+1,i+1)
926                   dissi(num_gp)  = diss(k,j+1,i+1)
927                   de_dxi(num_gp) = 0.0_wp
928                   de_dyi(num_gp) = de_dy(k,j+1,i+1)
929                   de_dzi(num_gp) = de_dz(k,j+1,i+1)
930                ENDIF
931
932!
933!--             If wall between gridpoint 1 and gridpoint 2, then
934!--             Neumann boundary condition has to be applied
935                IF ( gp_outside_of_building(1) == 1  .AND. &
936                     gp_outside_of_building(2) == 0 )  THEN
937                   num_gp = num_gp + 1
938                   location(num_gp,1) = i * dx
939                   location(num_gp,2) = j * dy + 0.5_wp * dy
940                   location(num_gp,3) = k * dz - 0.5_wp * dz
941                   ei(num_gp)     = e(k,j,i)
942                   dissi(num_gp)  = diss(k,j,i)
943                   de_dxi(num_gp) = de_dx(k,j,i)
944                   de_dyi(num_gp) = 0.0_wp
945                   de_dzi(num_gp) = de_dz(k,j,i) 
946                ENDIF
947
948                IF ( gp_outside_of_building(2) == 1  .AND. &
949                     gp_outside_of_building(1) == 0 )  THEN
950                   num_gp = num_gp + 1
951                   location(num_gp,1) = i * dx
952                   location(num_gp,2) = j * dy + 0.5_wp * dy
953                   location(num_gp,3) = k * dz - 0.5_wp * dz
954                   ei(num_gp)     = e(k,j+1,i)
955                   dissi(num_gp)  = diss(k,j+1,i)
956                   de_dxi(num_gp) = de_dx(k,j+1,i)
957                   de_dyi(num_gp) = 0.0_wp
958                   de_dzi(num_gp) = de_dz(k,j+1,i)
959                ENDIF
960
961!
962!--             If wall between gridpoint 3 and gridpoint 7, then
963!--             Neumann boundary condition has to be applied
964                IF ( gp_outside_of_building(3) == 1  .AND. &
965                     gp_outside_of_building(7) == 0 )  THEN
966                   num_gp = num_gp + 1
967                   location(num_gp,1) = i * dx + 0.5_wp * dx
968                   location(num_gp,2) = j * dy
969                   location(num_gp,3) = k * dz + 0.5_wp * dz
970                   ei(num_gp)     = e(k+1,j,i)
971                   dissi(num_gp)  = diss(k+1,j,i)
972                   de_dxi(num_gp) = 0.0_wp
973                   de_dyi(num_gp) = de_dy(k+1,j,i)
974                   de_dzi(num_gp) = de_dz(k+1,j,i) 
975                ENDIF
976
977                IF ( gp_outside_of_building(7) == 1  .AND. &
978                     gp_outside_of_building(3) == 0 )  THEN
979                   num_gp = num_gp + 1
980                   location(num_gp,1) = i * dx + 0.5_wp * dx
981                   location(num_gp,2) = j * dy
982                   location(num_gp,3) = k * dz + 0.5_wp * dz
983                   ei(num_gp)     = e(k+1,j,i+1)
984                   dissi(num_gp)  = diss(k+1,j,i+1)
985                   de_dxi(num_gp) = 0.0_wp
986                   de_dyi(num_gp) = de_dy(k+1,j,i+1)
987                   de_dzi(num_gp) = de_dz(k+1,j,i+1)
988                ENDIF
989
990!
991!--             If wall between gridpoint 7 and gridpoint 8, then
992!--             Neumann boundary condition has to be applied
993                IF ( gp_outside_of_building(7) == 1  .AND. &
994                     gp_outside_of_building(8) == 0 )  THEN
995                   num_gp = num_gp + 1
996                   location(num_gp,1) = (i+1) * dx
997                   location(num_gp,2) = j * dy + 0.5_wp * dy
998                   location(num_gp,3) = k * dz + 0.5_wp * dz
999                   ei(num_gp)     = e(k+1,j,i+1)
1000                   dissi(num_gp)  = diss(k+1,j,i+1)
1001                   de_dxi(num_gp) = de_dx(k+1,j,i+1)
1002                   de_dyi(num_gp) = 0.0_wp
1003                   de_dzi(num_gp) = de_dz(k+1,j,i+1)
1004                ENDIF
1005
1006                IF ( gp_outside_of_building(8) == 1  .AND. &
1007                     gp_outside_of_building(7) == 0 )  THEN
1008                   num_gp = num_gp + 1
1009                   location(num_gp,1) = (i+1) * dx
1010                   location(num_gp,2) = j * dy + 0.5_wp * dy
1011                   location(num_gp,3) = k * dz + 0.5_wp * dz
1012                   ei(num_gp)     = e(k+1,j+1,i+1)
1013                   dissi(num_gp)  = diss(k+1,j+1,i+1)
1014                   de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
1015                   de_dyi(num_gp) = 0.0_wp
1016                   de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
1017                ENDIF
1018
1019!
1020!--             If wall between gridpoint 4 and gridpoint 8, then
1021!--             Neumann boundary condition has to be applied
1022                IF ( gp_outside_of_building(4) == 1  .AND. &
1023                     gp_outside_of_building(8) == 0 )  THEN
1024                   num_gp = num_gp + 1
1025                   location(num_gp,1) = i * dx + 0.5_wp * dx
1026                   location(num_gp,2) = (j+1) * dy
1027                   location(num_gp,3) = k * dz + 0.5_wp * dz
1028                   ei(num_gp)     = e(k+1,j+1,i)
1029                   dissi(num_gp)  = diss(k+1,j+1,i)
1030                   de_dxi(num_gp) = 0.0_wp
1031                   de_dyi(num_gp) = de_dy(k+1,j+1,i)
1032                   de_dzi(num_gp) = de_dz(k+1,j+1,i)
1033                ENDIF
1034
1035                IF ( gp_outside_of_building(8) == 1  .AND. &
1036                     gp_outside_of_building(4) == 0 )  THEN
1037                   num_gp = num_gp + 1
1038                   location(num_gp,1) = i * dx + 0.5_wp * dx
1039                   location(num_gp,2) = (j+1) * dy
1040                   location(num_gp,3) = k * dz + 0.5_wp * dz
1041                   ei(num_gp)     = e(k+1,j+1,i+1)
1042                   dissi(num_gp)  = diss(k+1,j+1,i+1)
1043                   de_dxi(num_gp) = 0.0_wp
1044                   de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
1045                   de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
1046                ENDIF
1047
1048!
1049!--             If wall between gridpoint 3 and gridpoint 4, then
1050!--             Neumann boundary condition has to be applied
1051                IF ( gp_outside_of_building(3) == 1  .AND. &
1052                     gp_outside_of_building(4) == 0 )  THEN
1053                   num_gp = num_gp + 1
1054                   location(num_gp,1) = i * dx
1055                   location(num_gp,2) = j * dy + 0.5_wp * dy
1056                   location(num_gp,3) = k * dz + 0.5_wp * dz
1057                   ei(num_gp)     = e(k+1,j,i)
1058                   dissi(num_gp)  = diss(k+1,j,i)
1059                   de_dxi(num_gp) = de_dx(k+1,j,i)
1060                   de_dyi(num_gp) = 0.0_wp
1061                   de_dzi(num_gp) = de_dz(k+1,j,i)
1062                ENDIF
1063
1064                IF ( gp_outside_of_building(4) == 1  .AND. &
1065                     gp_outside_of_building(3) == 0 )  THEN
1066                   num_gp = num_gp + 1
1067                   location(num_gp,1) = i * dx
1068                   location(num_gp,2) = j * dy + 0.5_wp * dy
1069                   location(num_gp,3) = k * dz + 0.5_wp * dz
1070                   ei(num_gp)     = e(k+1,j+1,i)
1071                   dissi(num_gp)  = diss(k+1,j+1,i)
1072                   de_dxi(num_gp) = de_dx(k+1,j+1,i)
1073                   de_dyi(num_gp) = 0.0_wp
1074                   de_dzi(num_gp) = de_dz(k+1,j+1,i)
1075                ENDIF
1076
1077!
1078!--             If wall between gridpoint 1 and gridpoint 3, then
1079!--             Neumann boundary condition has to be applied
1080!--             (only one case as only building beneath is possible)
1081                IF ( gp_outside_of_building(1) == 0  .AND. &
1082                     gp_outside_of_building(3) == 1 )  THEN
1083                   num_gp = num_gp + 1
1084                   location(num_gp,1) = i * dx
1085                   location(num_gp,2) = j * dy
1086                   location(num_gp,3) = k * dz
1087                   ei(num_gp)     = e(k+1,j,i)
1088                   dissi(num_gp)  = diss(k+1,j,i)
1089                   de_dxi(num_gp) = de_dx(k+1,j,i)
1090                   de_dyi(num_gp) = de_dy(k+1,j,i)
1091                   de_dzi(num_gp) = 0.0_wp
1092                ENDIF
1093
1094!
1095!--             If wall between gridpoint 5 and gridpoint 7, then
1096!--             Neumann boundary condition has to be applied
1097!--             (only one case as only building beneath is possible)
1098                IF ( gp_outside_of_building(5) == 0  .AND. &
1099                     gp_outside_of_building(7) == 1 )  THEN
1100                   num_gp = num_gp + 1
1101                   location(num_gp,1) = (i+1) * dx
1102                   location(num_gp,2) = j * dy
1103                   location(num_gp,3) = k * dz
1104                   ei(num_gp)     = e(k+1,j,i+1)
1105                   dissi(num_gp)  = diss(k+1,j,i+1)
1106                   de_dxi(num_gp) = de_dx(k+1,j,i+1)
1107                   de_dyi(num_gp) = de_dy(k+1,j,i+1)
1108                   de_dzi(num_gp) = 0.0_wp
1109                ENDIF
1110
1111!
1112!--             If wall between gridpoint 2 and gridpoint 4, then
1113!--             Neumann boundary condition has to be applied
1114!--             (only one case as only building beneath is possible)
1115                IF ( gp_outside_of_building(2) == 0  .AND. &
1116                     gp_outside_of_building(4) == 1 )  THEN
1117                   num_gp = num_gp + 1
1118                   location(num_gp,1) = i * dx
1119                   location(num_gp,2) = (j+1) * dy
1120                   location(num_gp,3) = k * dz
1121                   ei(num_gp)     = e(k+1,j+1,i)
1122                   dissi(num_gp)  = diss(k+1,j+1,i)
1123                   de_dxi(num_gp) = de_dx(k+1,j+1,i)
1124                   de_dyi(num_gp) = de_dy(k+1,j+1,i)
1125                   de_dzi(num_gp) = 0.0_wp
1126                ENDIF
1127
1128!
1129!--             If wall between gridpoint 6 and gridpoint 8, then
1130!--             Neumann boundary condition has to be applied
1131!--             (only one case as only building beneath is possible)
1132                IF ( gp_outside_of_building(6) == 0  .AND. &
1133                     gp_outside_of_building(8) == 1 )  THEN
1134                   num_gp = num_gp + 1
1135                   location(num_gp,1) = (i+1) * dx
1136                   location(num_gp,2) = (j+1) * dy
1137                   location(num_gp,3) = k * dz
1138                   ei(num_gp)     = e(k+1,j+1,i+1)
1139                   dissi(num_gp)  = diss(k+1,j+1,i+1)
1140                   de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
1141                   de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
1142                   de_dzi(num_gp) = 0.0_wp
1143                ENDIF
1144 
1145!
1146!--             Carry out the interpolation
1147                IF ( num_gp == 1 )  THEN
1148!
1149!--                If only one of the gridpoints is situated outside of the
1150!--                building, it follows that the values at the particle
1151!--                location are the same as the gridpoint values
1152                   e_int(n)     = ei(num_gp)   
1153                   diss_int(n)  = dissi(num_gp) 
1154                   de_dx_int(n) = de_dxi(num_gp)
1155                   de_dy_int(n) = de_dyi(num_gp)
1156                   de_dz_int(n) = de_dzi(num_gp)
1157!
1158!--                Set flag for stochastic equation which disables calculation
1159!--                of drift and memory term near topography.
1160                   term_1_2(n) = 0.0_wp
1161                ELSE IF ( num_gp > 1 )  THEN
1162 
1163                   d_sum = 0.0_wp
1164!
1165!--                Evaluation of the distances between the gridpoints
1166!--                contributing to the interpolated values, and the particle
1167!--                location
1168                   DO  agp = 1, num_gp
1169                      d_gp_pl(agp) = ( particles(n)%x-location(agp,1) )**2  &
1170                                   + ( particles(n)%y-location(agp,2) )**2  &
1171                                   + ( zv(n)-location(agp,3) )**2
1172                      d_sum        = d_sum + d_gp_pl(agp)
1173                   ENDDO
1174 
1175!
1176!--                Finally the interpolation can be carried out
1177                   e_int(n)     = 0.0_wp 
1178                   diss_int(n)  = 0.0_wp 
1179                   de_dx_int(n) = 0.0_wp 
1180                   de_dy_int(n) = 0.0_wp 
1181                   de_dz_int(n) = 0.0_wp 
1182                   DO  agp = 1, num_gp
1183                      e_int(n)     = e_int(n)     + ( d_sum - d_gp_pl(agp) ) * &
1184                                             ei(agp) / ( (num_gp-1) * d_sum )
1185                      diss_int(n)  = diss_int(n)  + ( d_sum - d_gp_pl(agp) ) * &
1186                                          dissi(agp) / ( (num_gp-1) * d_sum )
1187                      de_dx_int(n) = de_dx_int(n) + ( d_sum - d_gp_pl(agp) ) * &
1188                                         de_dxi(agp) / ( (num_gp-1) * d_sum )
1189                      de_dy_int(n) = de_dy_int(n) + ( d_sum - d_gp_pl(agp) ) * &
1190                                         de_dyi(agp) / ( (num_gp-1) * d_sum )
1191                      de_dz_int(n) = de_dz_int(n) + ( d_sum - d_gp_pl(agp) ) * &
1192                                         de_dzi(agp) / ( (num_gp-1) * d_sum )
1193                   ENDDO
1194 
1195                ENDIF
1196                e_int(n)     = MAX( 1E-20_wp, e_int(n)     )
1197                diss_int(n)  = MAX( 1E-20_wp, diss_int(n)  )
1198                de_dx_int(n) = MAX( 1E-20_wp, de_dx_int(n) )
1199                de_dy_int(n) = MAX( 1E-20_wp, de_dy_int(n) ) 
1200                de_dz_int(n) = MAX( 1E-20_wp, de_dz_int(n) ) 
1201!
1202!--             Set flag for stochastic equation which disables calculation
1203!--             of drift and memory term near topography.
1204                term_1_2(n) = 0.0_wp
1205             ENDIF
1206          ENDDO
1207       ENDIF
1208
1209       DO nb = 0,7
1210          i = ip + block_offset(nb)%i_off
1211          j = jp + block_offset(nb)%j_off
1212          k = kp + block_offset(nb)%k_off
1213
1214          DO  n = start_index(nb), end_index(nb)
1215!
1216!--          Vertical interpolation of the horizontally averaged SGS TKE and
1217!--          resolved-scale velocity variances and use the interpolated values
1218!--          to calculate the coefficient fs, which is a measure of the ratio
1219!--          of the subgrid-scale turbulent kinetic energy to the total amount
1220!--          of turbulent kinetic energy.
1221             IF ( k == 0 )  THEN
1222                e_mean_int = hom(0,1,8,0)
1223             ELSE
1224                e_mean_int = hom(k,1,8,0) +                                    &
1225                                           ( hom(k+1,1,8,0) - hom(k,1,8,0) ) / &
1226                                           ( zu(k+1) - zu(k) ) *               &
1227                                           ( zv(n) - zu(k) )
1228             ENDIF
1229
1230             kw = kp - 1
1231
1232             IF ( k == 0 )  THEN
1233                aa  = hom(k+1,1,30,0)  * ( zv(n) / &
1234                                         ( 0.5_wp * ( zu(k+1) - zu(k) ) ) )
1235                bb  = hom(k+1,1,31,0)  * ( zv(n) / &
1236                                         ( 0.5_wp * ( zu(k+1) - zu(k) ) ) )
1237                cc  = hom(kw+1,1,32,0) * ( zv(n) / &
1238                                         ( 1.0_wp * ( zw(kw+1) - zw(kw) ) ) )
1239             ELSE
1240                aa  = hom(k,1,30,0) + ( hom(k+1,1,30,0) - hom(k,1,30,0) ) *    &
1241                           ( ( zv(n) - zu(k) ) / ( zu(k+1) - zu(k) ) )
1242                bb  = hom(k,1,31,0) + ( hom(k+1,1,31,0) - hom(k,1,31,0) ) *    &
1243                           ( ( zv(n) - zu(k) ) / ( zu(k+1) - zu(k) ) )
1244                cc  = hom(kw,1,32,0) + ( hom(kw+1,1,32,0)-hom(kw,1,32,0) ) *   &
1245                           ( ( zv(n) - zw(kw) ) / ( zw(kw+1)-zw(kw) ) )
1246             ENDIF
1247
1248             vv_int = ( 1.0_wp / 3.0_wp ) * ( aa + bb + cc )
1249!
1250!--          Needed to avoid NaN particle velocities. The value of 1.0 is just
1251!--          an educated guess for the given case.
1252             IF ( vv_int + ( 2.0_wp / 3.0_wp ) * e_mean_int == 0.0_wp )  THEN
1253                fs_int(n) = 1.0_wp
1254             ELSE
1255                fs_int(n) = ( 2.0_wp / 3.0_wp ) * e_mean_int /                 &
1256                            ( vv_int + ( 2.0_wp / 3.0_wp ) * e_mean_int )
1257             ENDIF
1258
1259          ENDDO
1260       ENDDO
1261
1262       DO  n = 1, number_of_particles
1263
1264         rg(n,1) = random_gauss( iran_part, 5.0_wp )
1265         rg(n,2) = random_gauss( iran_part, 5.0_wp )
1266         rg(n,3) = random_gauss( iran_part, 5.0_wp )
1267
1268       ENDDO
1269
1270       DO  n = 1, number_of_particles
1271!
1272!--       Calculate the Lagrangian timescale according to Weil et al. (2004).
1273          lagr_timescale = ( 4.0_wp * e_int(n) + 1E-20_wp ) / &
1274                           ( 3.0_wp * fs_int(n) * c_0 * diss_int(n) + 1E-20_wp )
1275
1276!
1277!--       Calculate the next particle timestep. dt_gap is the time needed to
1278!--       complete the current LES timestep.
1279          dt_gap = dt_3d - particles(n)%dt_sum
1280          dt_particle(n) = MIN( dt_3d, 0.025_wp * lagr_timescale, dt_gap )
1281
1282!
1283!--       The particle timestep should not be too small in order to prevent
1284!--       the number of particle timesteps of getting too large
1285          IF ( dt_particle(n) < dt_min_part  .AND.  dt_min_part < dt_gap )  THEN
1286             dt_particle(n) = dt_min_part
1287          ENDIF
1288
1289!
1290!--       Calculate the SGS velocity components
1291          IF ( particles(n)%age == 0.0_wp )  THEN
1292!
1293!--          For new particles the SGS components are derived from the SGS
1294!--          TKE. Limit the Gaussian random number to the interval
1295!--          [-5.0*sigma, 5.0*sigma] in order to prevent the SGS velocities
1296!--          from becoming unrealistically large.
1297             particles(n)%rvar1 = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) *   &
1298                                  ( rg(n,1) - 1.0_wp )
1299             particles(n)%rvar2 = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) *   &
1300                                  ( rg(n,2) - 1.0_wp )
1301             particles(n)%rvar3 = SQRT( 2.0_wp * sgs_wf_part * e_int(n) + 1E-20_wp ) *   &
1302                                  ( rg(n,3) - 1.0_wp )
1303
1304          ELSE
1305!
1306!--          Restriction of the size of the new timestep: compared to the
1307!--          previous timestep the increase must not exceed 200%
1308
1309             dt_particle_m = particles(n)%age - particles(n)%age_m
1310             IF ( dt_particle(n) > 2.0_wp * dt_particle_m )  THEN
1311                dt_particle(n) = 2.0_wp * dt_particle_m
1312             ENDIF
1313
1314!
1315!--          For old particles the SGS components are correlated with the
1316!--          values from the previous timestep. Random numbers have also to
1317!--          be limited (see above).
1318!--          As negative values for the subgrid TKE are not allowed, the
1319!--          change of the subgrid TKE with time cannot be smaller than
1320!--          -e_int(n)/dt_particle. This value is used as a lower boundary
1321!--          value for the change of TKE
1322
1323             de_dt_min = - e_int(n) / dt_particle(n)
1324
1325             de_dt = ( e_int(n) - particles(n)%e_m ) / dt_particle_m
1326
1327             IF ( de_dt < de_dt_min )  THEN
1328                de_dt = de_dt_min
1329             ENDIF
1330
1331             CALL weil_stochastic_eq(particles(n)%rvar1, fs_int(n), e_int(n),  & 
1332                                     de_dx_int(n), de_dt, diss_int(n),         &
1333                                     dt_particle(n), rg(n,1), term_1_2(n) )
1334
1335             CALL weil_stochastic_eq(particles(n)%rvar2, fs_int(n), e_int(n),  & 
1336                                     de_dy_int(n), de_dt, diss_int(n),         &
1337                                     dt_particle(n), rg(n,2), term_1_2(n) )
1338
1339             CALL weil_stochastic_eq(particles(n)%rvar3, fs_int(n), e_int(n),  & 
1340                                     de_dz_int(n), de_dt, diss_int(n),         &
1341                                     dt_particle(n), rg(n,3), term_1_2(n) )
1342
1343          ENDIF
1344
1345          u_int(n) = u_int(n) + particles(n)%rvar1
1346          v_int(n) = v_int(n) + particles(n)%rvar2
1347          w_int(n) = w_int(n) + particles(n)%rvar3
1348!
1349!--       Store the SGS TKE of the current timelevel which is needed for
1350!--       for calculating the SGS particle velocities at the next timestep
1351          particles(n)%e_m = e_int(n)
1352       ENDDO
1353
1354    ELSE
1355!
1356!--    If no SGS velocities are used, only the particle timestep has to
1357!--    be set
1358       dt_particle = dt_3d
1359
1360    ENDIF
1361!
1362!-- Store the old age of the particle ( needed to prevent that a
1363!-- particle crosses several PEs during one timestep, and for the
1364!-- evaluation of the subgrid particle velocity fluctuations )
1365    particles(1:number_of_particles)%age_m = particles(1:number_of_particles)%age
1366
1367    dens_ratio = particle_groups(particles(1:number_of_particles)%group)%density_ratio
1368
1369    IF ( ANY( dens_ratio == 0.0_wp ) )  THEN
1370       DO  n = 1, number_of_particles
1371
1372!
1373!--       Particle advection
1374          IF ( dens_ratio(n) == 0.0_wp )  THEN
1375!
1376!--          Pure passive transport (without particle inertia)
1377             particles(n)%x = xv(n) + u_int(n) * dt_particle(n)
1378             particles(n)%y = yv(n) + v_int(n) * dt_particle(n)
1379             particles(n)%z = zv(n) + w_int(n) * dt_particle(n)
1380
1381             particles(n)%speed_x = u_int(n)
1382             particles(n)%speed_y = v_int(n)
1383             particles(n)%speed_z = w_int(n)
1384
1385          ELSE
1386!
1387!--          Transport of particles with inertia
1388             particles(n)%x = particles(n)%x + particles(n)%speed_x * &
1389                                               dt_particle(n)
1390             particles(n)%y = particles(n)%y + particles(n)%speed_y * &
1391                                               dt_particle(n)
1392             particles(n)%z = particles(n)%z + particles(n)%speed_z * &
1393                                               dt_particle(n)
1394
1395!
1396!--          Update of the particle velocity
1397             IF ( cloud_droplets )  THEN
1398!
1399!--             Terminal velocity is computed for vertical direction (Rogers et
1400!--             al., 1993, J. Appl. Meteorol.)
1401                diameter = particles(n)%radius * 2000.0_wp !diameter in mm
1402                IF ( diameter <= d0_rog )  THEN
1403                   w_s = k_cap_rog * diameter * ( 1.0_wp - EXP( -k_low_rog * diameter ) )
1404                ELSE
1405                   w_s = a_rog - b_rog * EXP( -c_rog * diameter )
1406                ENDIF
1407
1408!
1409!--             If selected, add random velocities following Soelch and Kaercher
1410!--             (2010, Q. J. R. Meteorol. Soc.)
1411                IF ( use_sgs_for_particles )  THEN
1412                   lagr_timescale = km(kp,jp,ip) / MAX( e(kp,jp,ip), 1.0E-20_wp )
1413                   RL             = EXP( -1.0_wp * dt_3d / lagr_timescale )
1414                   sigma          = SQRT( e(kp,jp,ip) )
1415
1416                   rg1 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1417                   rg2 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1418                   rg3 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1419
1420                   particles(n)%rvar1 = RL * particles(n)%rvar1 +              &
1421                                        SQRT( 1.0_wp - RL**2 ) * sigma * rg1
1422                   particles(n)%rvar2 = RL * particles(n)%rvar2 +              &
1423                                        SQRT( 1.0_wp - RL**2 ) * sigma * rg2
1424                   particles(n)%rvar3 = RL * particles(n)%rvar3 +              &
1425                                        SQRT( 1.0_wp - RL**2 ) * sigma * rg3
1426
1427                   particles(n)%speed_x = u_int(n) + particles(n)%rvar1
1428                   particles(n)%speed_y = v_int(n) + particles(n)%rvar2
1429                   particles(n)%speed_z = w_int(n) + particles(n)%rvar3 - w_s
1430                ELSE
1431                   particles(n)%speed_x = u_int(n)
1432                   particles(n)%speed_y = v_int(n)
1433                   particles(n)%speed_z = w_int(n) - w_s
1434                ENDIF
1435
1436             ELSE
1437
1438                IF ( use_sgs_for_particles )  THEN
1439                   exp_arg  = particle_groups(particles(n)%group)%exp_arg
1440                   exp_term = EXP( -exp_arg * dt_particle(n) )
1441                ELSE
1442                   exp_arg  = particle_groups(particles(n)%group)%exp_arg
1443                   exp_term = particle_groups(particles(n)%group)%exp_term
1444                ENDIF
1445                particles(n)%speed_x = particles(n)%speed_x * exp_term +         &
1446                                       u_int(n) * ( 1.0_wp - exp_term )
1447                particles(n)%speed_y = particles(n)%speed_y * exp_term +         &
1448                                       v_int(n) * ( 1.0_wp - exp_term )
1449                particles(n)%speed_z = particles(n)%speed_z * exp_term +         &
1450                                       ( w_int(n) - ( 1.0_wp - dens_ratio(n) ) * &
1451                                       g / exp_arg ) * ( 1.0_wp - exp_term )
1452             ENDIF
1453
1454          ENDIF
1455
1456       ENDDO
1457   
1458    ELSE
1459
1460       DO  n = 1, number_of_particles
1461
1462!--       Transport of particles with inertia
1463          particles(n)%x = xv(n) + particles(n)%speed_x * dt_particle(n)
1464          particles(n)%y = yv(n) + particles(n)%speed_y * dt_particle(n)
1465          particles(n)%z = zv(n) + particles(n)%speed_z * dt_particle(n)
1466!
1467!--       Update of the particle velocity
1468          IF ( cloud_droplets )  THEN
1469!
1470!--          Terminal velocity is computed for vertical direction (Rogers et al.,
1471!--          1993, J. Appl. Meteorol.)
1472             diameter = particles(n)%radius * 2000.0_wp !diameter in mm
1473             IF ( diameter <= d0_rog )  THEN
1474                w_s = k_cap_rog * diameter * ( 1.0_wp - EXP( -k_low_rog * diameter ) )
1475             ELSE
1476                w_s = a_rog - b_rog * EXP( -c_rog * diameter )
1477             ENDIF
1478
1479!
1480!--          If selected, add random velocities following Soelch and Kaercher
1481!--          (2010, Q. J. R. Meteorol. Soc.)
1482             IF ( use_sgs_for_particles )  THEN
1483                 lagr_timescale = km(kp,jp,ip) / MAX( e(kp,jp,ip), 1.0E-20_wp )
1484                 RL             = EXP( -1.0_wp * dt_3d / lagr_timescale )
1485                 sigma          = SQRT( e(kp,jp,ip) )
1486
1487                 rg1 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1488                 rg2 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1489                 rg3 = random_gauss( iran_part, 5.0_wp ) - 1.0_wp
1490
1491                 particles(n)%rvar1 = RL * particles(n)%rvar1 +                &
1492                                      SQRT( 1.0_wp - RL**2 ) * sigma * rg1
1493                 particles(n)%rvar2 = RL * particles(n)%rvar2 +                &
1494                                      SQRT( 1.0_wp - RL**2 ) * sigma * rg2
1495                 particles(n)%rvar3 = RL * particles(n)%rvar3 +                &
1496                                      SQRT( 1.0_wp - RL**2 ) * sigma * rg3
1497
1498                 particles(n)%speed_x = u_int(n) + particles(n)%rvar1
1499                 particles(n)%speed_y = v_int(n) + particles(n)%rvar2
1500                 particles(n)%speed_z = w_int(n) + particles(n)%rvar3 - w_s
1501             ELSE
1502                 particles(n)%speed_x = u_int(n)
1503                 particles(n)%speed_y = v_int(n)
1504                 particles(n)%speed_z = w_int(n) - w_s
1505             ENDIF
1506
1507          ELSE
1508
1509             IF ( use_sgs_for_particles )  THEN
1510                exp_arg  = particle_groups(particles(n)%group)%exp_arg
1511                exp_term = EXP( -exp_arg * dt_particle(n) )
1512             ELSE
1513                exp_arg  = particle_groups(particles(n)%group)%exp_arg
1514                exp_term = particle_groups(particles(n)%group)%exp_term
1515             ENDIF
1516             particles(n)%speed_x = particles(n)%speed_x * exp_term +             &
1517                                    u_int(n) * ( 1.0_wp - exp_term )
1518             particles(n)%speed_y = particles(n)%speed_y * exp_term +             &
1519                                    v_int(n) * ( 1.0_wp - exp_term )
1520             particles(n)%speed_z = particles(n)%speed_z * exp_term +             &
1521                                    ( w_int(n) - ( 1.0_wp - dens_ratio(n) ) * g / &
1522                                    exp_arg ) * ( 1.0_wp - exp_term )
1523          ENDIF
1524
1525       ENDDO
1526
1527    ENDIF
1528
1529    DO  n = 1, number_of_particles
1530!
1531!--    Increment the particle age and the total time that the particle
1532!--    has advanced within the particle timestep procedure
1533       particles(n)%age    = particles(n)%age    + dt_particle(n)
1534       particles(n)%dt_sum = particles(n)%dt_sum + dt_particle(n)
1535
1536!
1537!--    Check whether there is still a particle that has not yet completed
1538!--    the total LES timestep
1539       IF ( ( dt_3d - particles(n)%dt_sum ) > 1E-8_wp )  THEN
1540          dt_3d_reached_l = .FALSE.
1541       ENDIF
1542
1543    ENDDO
1544
1545    CALL cpu_log( log_point_s(44), 'lpm_advec', 'pause' )
1546
1547
1548 END SUBROUTINE lpm_advec
1549
1550! Description:
1551! ------------
1552!> Calculation of subgrid-scale particle speed using the stochastic model
1553!> of Weil et al. (2004, JAS, 61, 2877-2887).
1554!------------------------------------------------------------------------------!
1555 SUBROUTINE weil_stochastic_eq( v_sgs, fs_n, e_n, dedxi_n, dedt_n, diss_n,     &
1556                                dt_n, rg_n, fac )
1557
1558    USE kinds
1559
1560    USE particle_attributes,                                                   &
1561        ONLY:  c_0, sgs_wf_part
1562
1563    IMPLICIT NONE
1564
1565    REAL(wp) ::  a1      !< dummy argument
1566    REAL(wp) ::  dedt_n  !< time derivative of TKE at particle position
1567    REAL(wp) ::  dedxi_n !< horizontal derivative of TKE at particle position
1568    REAL(wp) ::  diss_n  !< dissipation at particle position
1569    REAL(wp) ::  dt_n    !< particle timestep
1570    REAL(wp) ::  e_n     !< TKE at particle position
1571    REAL(wp) ::  fac     !< flag to identify adjacent topography
1572    REAL(wp) ::  fs_n    !< weighting factor to prevent that subgrid-scale particle speed becomes too large
1573    REAL(wp) ::  sgs_w   !< constant (1/3)
1574    REAL(wp) ::  rg_n    !< random number
1575    REAL(wp) ::  term1   !< memory term
1576    REAL(wp) ::  term2   !< drift correction term
1577    REAL(wp) ::  term3   !< random term
1578    REAL(wp) ::  v_sgs   !< subgrid-scale velocity component
1579
1580!
1581!-- Please note, terms 1 and 2 (drift and memory term, respectively) are
1582!-- multiplied by a flag to switch of both terms near topography.
1583!-- This is necessary, as both terms may cause a subgrid-scale velocity build up
1584!-- if particles are trapped in regions with very small TKE, e.g. in narrow street
1585!-- canyons resolved by only a few grid points. Hence, term 1 and term 2 are
1586!-- disabled if one of the adjacent grid points belongs to topography.
1587!-- Moreover, in this case, the  previous subgrid-scale component is also set
1588!-- to zero.
1589
1590    a1 = fs_n * c_0 * diss_n
1591!
1592!-- Memory term
1593    term1 = - a1 * v_sgs * dt_n / ( 4.0_wp * sgs_wf_part * e_n + 1E-20_wp )    &
1594                 * fac
1595!
1596!-- Drift correction term
1597    term2 = ( ( dedt_n * v_sgs / e_n ) + dedxi_n ) * 0.5_wp * dt_n              &
1598                 * fac
1599!
1600!-- Random term
1601    term3 = SQRT( MAX( a1, 1E-20 ) ) * ( rg_n - 1.0_wp ) * SQRT( dt_n )
1602!
1603!-- In cese one of the adjacent grid-boxes belongs to topograhy, the previous
1604!-- subgrid-scale velocity component is set to zero, in order to prevent a
1605!-- velocity build-up.
1606
1607!-- This case, set also previous subgrid-scale component to zero.
1608    v_sgs = v_sgs * fac + term1 + term2 + term3
1609
1610 END SUBROUTINE weil_stochastic_eq
Note: See TracBrowser for help on using the repository browser.