source: palm/trunk/SOURCE/lpm_splitting.f90 @ 2716

Last change on this file since 2716 was 2716, checked in by kanani, 6 years ago

Correction of "Former revisions" section

  • Property svn:keywords set to Id
File size: 30.8 KB
Line 
1!> @file lpm_splitting.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: lpm_splitting.f90 2716 2017-12-29 16:35:59Z kanani $
27! Corrected "Former revisions" section
28!
29!
30! Change in file header (GPL part)
31!
32! Added comments
33!
34!
35! 2263 2017-06-08 14:59:01Z schwenkel
36! Initial revision
37!
38!
39!
40! Description:
41! ------------
42! This routine is a part of the Lagrangian particle model. Super droplets which
43! fulfill certain criterion's (e.g. a big weighting factor and a large radius)
44! can be split into several super droplets with a reduced number of
45! represented particles of every super droplet. This mechanism ensures an
46! improved representation of the right tail of the drop size distribution with
47! a feasible amount of computational costs. The limits of particle creation
48! should be chosen carefully! The idea of this algorithm is based on
49! Unterstrasser and Soelch, 2014.
50!------------------------------------------------------------------------------!
51 SUBROUTINE lpm_splitting
52
53
54    USE arrays_3d,                                                             &
55        ONLY:  ql
56
57    USE cloud_parameters,                                                      &
58        ONLY:  rho_l
59
60    USE constants,                                                             &
61        ONLY:  pi
62
63    USE cpulog,                                                                &
64        ONLY:  cpu_log, log_point_s
65
66    USE indices,                                                               &
67        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
68
69    USE kinds
70
71    USE lpm_exchange_horiz_mod,                                                &
72        ONLY:  realloc_particles_array
73
74    USE particle_attributes,                                                   &
75        ONLY:  grid_particles, iran_part, initial_weighting_factor, isf,       &
76               i_splitting_mode, max_number_particles_per_gridbox,             & 
77               new_particles, n_max, number_concentration,                     &
78               number_of_particles, number_particles_per_gridbox, particles,   &
79               particle_type, prt_count, radius_split, splitting,              &
80               splitting_factor, splitting_factor_max, splitting_mode,         &
81               sum_new_particles, weight_factor_split                       
82
83    USE pegrid
84
85    IMPLICIT NONE
86
87    INTEGER(iwp) ::  i                !<
88    INTEGER(iwp) ::  j                !<
89    INTEGER(iwp) ::  jpp              !<
90    INTEGER(iwp) ::  k                !<
91    INTEGER(iwp) ::  n                !<
92    INTEGER(iwp) ::  new_particles_gb !< counter of created particles within one grid box
93    INTEGER(iwp) ::  new_size         !< new particle array size
94    INTEGER(iwp) ::  np               !<
95    INTEGER(iwp) ::  old_size         !< old particle array size
96   
97    LOGICAL ::  first_loop_stride = .TRUE. !< flag to calculate constants only once
98
99    REAL(wp) ::  diameter                 !< diameter of droplet
100    REAL(wp) ::  dlog                     !< factor for DSD calculation
101    REAL(wp) ::  factor_volume_to_mass    !< pre calculate factor volume to mass
102    REAL(wp) ::  lambda                   !< slope parameter of gamma-distribution
103    REAL(wp) ::  lwc                      !< liquid water content of grid box
104    REAL(wp) ::  lwc_total                !< average liquid water content of cloud
105    REAL(wp) ::  m1                       !< first moment of DSD
106    REAL(wp) ::  m1_total                 !< average over all PEs of first moment of DSD
107    REAL(wp) ::  m2                       !< second moment of DSD
108    REAL(wp) ::  m2_total                 !< average average over all PEs second moment of DSD
109    REAL(wp) ::  m3                       !< third moment of DSD
110    REAL(wp) ::  m3_total                 !< average average over all PEs third moment of DSD
111    REAL(wp) ::  mu                       !< spectral shape parameter of gamma distribution
112    REAL(wp) ::  nrclgb                   !< number of cloudy grid boxes (ql >= 1.0E-5 kg/kg)
113    REAL(wp) ::  nrclgb_total             !< average over all PEs of number of cloudy grid boxes
114    REAL(wp) ::  nr                       !< number concentration of cloud droplets
115    REAL(wp) ::  nr_total                 !< average over all PEs of number of cloudy grid boxes
116    REAL(wp) ::  nr0                      !< intercept parameter of gamma distribution
117    REAL(wp) ::  pirho_l                  !< pi * rho_l / 6.0
118    REAL(wp) ::  ql_crit = 1.0E-5_wp      !< threshold lwc for cloudy grid cells
119                                          !< (Siebesma et al 2003, JAS, 60)
120    REAL(wp) ::  rm                       !< volume averaged mean radius
121    REAL(wp) ::  rm_total                 !< average over all PEs of volume averaged mean radius
122    REAL(wp) ::  r_min = 1.0E-6_wp        !< minimum radius of approximated spectra
123    REAL(wp) ::  r_max = 1.0E-3_wp        !< maximum radius of approximated spectra
124    REAL(wp) ::  sigma_log = 1.5_wp       !< standard deviation of the LOG-distribution
125    REAL(wp) ::  zeta                     !< Parameter for DSD calculation of Seifert
126
127    REAL(wp), DIMENSION(0:n_max-1) ::  an_spl     !< size dependent critical weight factor
128    REAL(wp), DIMENSION(0:n_max-1) ::  r_bin_mid  !< mass weighted mean radius of a bin
129    REAL(wp), DIMENSION(0:n_max)   ::  r_bin      !< boundaries of a radius bin
130   
131    TYPE(particle_type) ::  tmp_particle   !< temporary particle TYPE
132
133    CALL cpu_log( log_point_s(80), 'lpm_splitting', 'start' )
134
135    IF ( first_loop_stride )  THEN
136       IF ( i_splitting_mode == 2  .OR.  i_splitting_mode == 3 )  THEN
137          dlog   = ( LOG10(r_max) - LOG10(r_min) ) / ( n_max - 1 )
138          DO  i = 0, n_max-1
139             r_bin(i) = 10.0_wp**( LOG10(r_min) + i * dlog - 0.5_wp * dlog )
140             r_bin_mid(i) = 10.0_wp**( LOG10(r_min) + i * dlog )
141          ENDDO
142          r_bin(n_max) = 10.0_wp**( LOG10(r_min) + n_max * dlog - 0.5_wp * dlog )
143       ENDIF   
144       factor_volume_to_mass =  4.0_wp / 3.0_wp * pi * rho_l
145       pirho_l  = pi * rho_l / 6.0_wp
146       IF ( weight_factor_split == -1.0_wp )  THEN
147          weight_factor_split = 0.1_wp * initial_weighting_factor 
148       ENDIF
149    ENDIF
150
151    new_particles  = 0
152
153    IF ( i_splitting_mode == 1 )  THEN
154
155       DO  i = nxl, nxr
156          DO  j = nys, nyn
157             DO  k = nzb+1, nzt
158
159                new_particles_gb = 0
160                number_of_particles = prt_count(k,j,i)
161                IF ( number_of_particles <= 0  .OR.                            & 
162                     ql(k,j,i) < ql_crit )  CYCLE
163                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
164!               
165!--             Start splitting operations. Each particle is checked if it
166!--             fulfilled the splitting criterion's. In splitting mode 'const'   
167!--             a critical radius  (radius_split) a critical weighting factor
168!--             (weight_factor_split) and a splitting factor (splitting_factor)
169!--             must  be prescribed (see particles_par). Super droplets which
170!--             have a larger radius and larger weighting factor are split into
171!--             'splitting_factor' super droplets. Therefore, the weighting
172!--             factor of  the super droplet and all created clones is reduced
173!--             by the factor of 'splitting_factor'.
174                DO  n = 1, number_of_particles
175                   IF ( particles(n)%particle_mask  .AND.                      &
176                        particles(n)%radius >= radius_split  .AND.             & 
177                        particles(n)%weight_factor >= weight_factor_split )    &
178                   THEN         
179!
180!--                   Calculate the new number of particles.
181                      new_size = prt_count(k,j,i) + splitting_factor - 1                                   
182!
183!--                   Cycle if maximum number of particles per grid box
184!--                   is greater than the allowed maximum number.
185                      IF ( new_size >= max_number_particles_per_gridbox )  CYCLE                     
186!
187!--                   Reallocate particle array if necessary.
188                      IF ( new_size > SIZE(particles) )  THEN
189                         CALL realloc_particles_array(i,j,k,new_size)
190                      ENDIF
191                      old_size = prt_count(k,j,i)
192!
193!--                   Calculate new weighting factor.
194                      particles(n)%weight_factor =  & 
195                         particles(n)%weight_factor / splitting_factor
196                      tmp_particle = particles(n)
197!
198!--                   Create splitting_factor-1 new particles.
199                      DO  jpp = 1, splitting_factor-1
200                         grid_particles(k,j,i)%particles(jpp+old_size) =       & 
201                            tmp_particle         
202                      ENDDO 
203                      new_particles_gb = new_particles_gb + splitting_factor - 1
204!   
205!--                   Save the new number of super droplets for every grid box.
206                      prt_count(k,j,i) = prt_count(k,j,i) +                    &
207                                         splitting_factor - 1         
208                   ENDIF
209                ENDDO
210               
211                new_particles       = new_particles     + new_particles_gb
212                sum_new_particles   = sum_new_particles + new_particles_gb 
213             ENDDO
214          ENDDO
215       ENDDO
216
217    ELSEIF ( i_splitting_mode == 2 )  THEN 
218!
219!--    Initialize summing variables.
220       lwc          = 0.0_wp
221       lwc_total    = 0.0_wp 
222       m1           = 0.0_wp
223       m1_total     = 0.0_wp
224       m2           = 0.0_wp
225       m2_total     = 0.0_wp
226       m3           = 0.0_wp
227       m3_total     = 0.0_wp
228       nr           = 0.0_wp   
229       nrclgb       = 0.0_wp
230       nrclgb_total = 0.0_wp 
231       nr_total     = 0.0_wp
232       rm           = 0.0_wp
233       rm_total     = 0.0_wp
234       
235       DO  i = nxl, nxr
236          DO  j = nys, nyn
237             DO  k = nzb+1, nzt
238                number_of_particles = prt_count(k,j,i)
239                IF ( number_of_particles <= 0  .OR.                            & 
240                     ql(k,j,i) < ql_crit )  CYCLE
241                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
242                nrclgb = nrclgb + 1.0_wp
243!               
244!--             Calculate moments of DSD.               
245                DO  n = 1, number_of_particles
246                   IF ( particles(n)%particle_mask  .AND.                      &
247                        particles(n)%radius >= r_min )                         &
248                   THEN
249                      nr  = nr  + particles(n)%weight_factor
250                      rm  = rm  + factor_volume_to_mass  *                     &
251                                 particles(n)%radius**3  *                     &
252                                 particles(n)%weight_factor
253                      IF ( isf == 1 )  THEN           
254                         diameter   = particles(n)%radius * 2.0_wp           
255                         lwc = lwc + factor_volume_to_mass *                   &
256                                     particles(n)%radius**3 *                  & 
257                                     particles(n)%weight_factor 
258                         m1  = m1  + particles(n)%weight_factor * diameter                                               
259                         m2  = m2  + particles(n)%weight_factor * diameter**2           
260                         m3  = m3  + particles(n)%weight_factor * diameter**3
261                      ENDIF   
262                   ENDIF                       
263                ENDDO 
264             ENDDO
265          ENDDO
266       ENDDO
267
268#if defined( __parallel )
269       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
270       CALL MPI_ALLREDUCE( nr, nr_total, 1 , &
271       MPI_REAL, MPI_SUM, comm2d, ierr )
272       CALL MPI_ALLREDUCE( rm, rm_total, 1 , &
273       MPI_REAL, MPI_SUM, comm2d, ierr )
274       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
275       CALL MPI_ALLREDUCE( nrclgb, nrclgb_total, 1 , &
276       MPI_REAL, MPI_SUM, comm2d, ierr )
277       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
278       CALL MPI_ALLREDUCE( lwc, lwc_total, 1 , &
279       MPI_REAL, MPI_SUM, comm2d, ierr )
280       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
281       CALL MPI_ALLREDUCE( m1, m1_total, 1 , &
282       MPI_REAL, MPI_SUM, comm2d, ierr )
283       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
284       CALL MPI_ALLREDUCE( m2, m2_total, 1 , &
285       MPI_REAL, MPI_SUM, comm2d, ierr )
286       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
287       CALL MPI_ALLREDUCE( m3, m3_total, 1 , &
288       MPI_REAL, MPI_SUM, comm2d, ierr )
289#endif 
290
291!
292!--    Calculate number concentration and mean volume averaged radius.
293       nr_total = MERGE( nr_total / nrclgb_total,                              &
294                         0.0_wp, nrclgb_total > 0.0_wp                         &
295                       )
296       rm_total = MERGE( ( rm_total /                                          &
297                            ( nr_total * factor_volume_to_mass )               &
298                          )**0.3333333_wp, 0.0_wp, nrclgb_total > 0.0_wp       &
299                       )                         
300!
301!--    Check which function should be used to approximate the DSD.
302       IF ( isf == 1 )  THEN
303          lwc_total = MERGE( lwc_total / nrclgb_total,                         &
304                             0.0_wp, nrclgb_total > 0.0_wp                     &
305                           )
306          m1_total  = MERGE( m1_total / nrclgb_total,                          &
307                             0.0_wp, nrclgb_total > 0.0_wp                     &
308                           )
309          m2_total  = MERGE( m2_total / nrclgb_total,                          &
310                             0.0_wp, nrclgb_total > 0.0_wp                     &
311                           )
312          m3_total  = MERGE( m3_total / nrclgb_total,                          &
313                             0.0_wp, nrclgb_total > 0.0_wp                     &
314                           )
315          zeta = m1_total * m3_total / m2_total**2                             
316          mu   = MAX( ( ( 1.0_wp - zeta ) * 2.0_wp + 1.0_wp ) /                &
317                        ( zeta - 1.0_wp ), 0.0_wp                              &
318                    )
319
320          lambda = ( pirho_l * nr_total / lwc_total *                          &
321                     ( mu + 3.0_wp ) * ( mu + 2.0_wp ) * ( mu + 1.0_wp )       &                                         
322                   )**0.3333333_wp
323          nr0 = nr_total / gamma( mu + 1.0_wp ) * lambda**( mu + 1.0_wp ) 
324         
325          DO  n = 0, n_max-1
326             diameter  = r_bin_mid(n) * 2.0_wp           
327             an_spl(n) = nr0 * diameter**mu * EXP( -lambda * diameter ) *      & 
328                         ( r_bin(n+1) - r_bin(n) ) * 2.0_wp 
329          ENDDO
330       ELSEIF ( isf == 2 )  THEN
331          DO  n = 0, n_max-1
332             an_spl(n) = nr_total / ( SQRT( 2.0_wp * pi ) *                    &
333                                     LOG(sigma_log) * r_bin_mid(n)             &
334                                     ) *                                       &
335                         EXP( -( LOG( r_bin_mid(n) / rm_total )**2 ) /         &
336                               ( 2.0_wp * LOG(sigma_log)**2 )                  & 
337                             ) *                                               & 
338                         ( r_bin(n+1) - r_bin(n) )
339          ENDDO
340       ELSEIF( isf == 3 )  THEN
341          DO  n = 0, n_max-1 
342             an_spl(n) = 3.0_wp * nr_total * r_bin_mid(n)**2 / rm_total**3  *  &
343                         EXP( - ( r_bin_mid(n)**3 / rm_total**3 ) )         *  &
344                         ( r_bin(n+1) - r_bin(n) )
345          ENDDO
346       ENDIF
347!
348!--    Criterion to avoid super droplets with a weighting factor < 1.0.
349       an_spl = MAX(an_spl, 1.0_wp)
350 
351       DO  i = nxl, nxr
352          DO  j = nys, nyn
353             DO  k = nzb+1, nzt
354                number_of_particles = prt_count(k,j,i)
355                IF ( number_of_particles <= 0  .OR.                            & 
356                     ql(k,j,i) < ql_crit )  CYCLE
357                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
358                new_particles_gb = 0         
359!               
360!--             Start splitting operations. Each particle is checked if it
361!--             fulfilled the splitting criterion's. In splitting mode 'cl_av'   
362!--             a critical radius (radius_split) and a splitting function must
363!--             be prescribed (see particles_par). The critical weighting factor
364!--             is calculated while approximating a 'gamma', 'log' or 'exp'-
365!--             drop size distribution. In this mode the DSD is calculated as
366!--             an average over all cloudy grid boxes. Super droplets which
367!--             have a larger radius and larger weighting factor are split into
368!--             'splitting_factor' super droplets. In this case the splitting 
369!--             factor is calculated of weighting factor of the super droplet 
370!--             and the approximated number concentration for droplet of such
371!--             a size. Due to the splitting, the weighting factor of the 
372!--             super droplet and all created clones is reduced by the factor 
373!--             of 'splitting_facor'.
374                DO  n = 1, number_of_particles
375                   DO  np = 0, n_max-1
376                      IF ( r_bin(np) >= radius_split  .AND.                    &
377                           particles(n)%particle_mask  .AND.                   &
378                           particles(n)%radius >= r_bin(np)  .AND.             &
379                           particles(n)%radius < r_bin(np+1)  .AND.            &
380                           particles(n)%weight_factor >= an_spl(np)  )         &
381                      THEN
382!
383!--                      Calculate splitting factor
384                         splitting_factor =                                    & 
385                             MIN( INT( particles(n)%weight_factor /            &
386                                        an_spl(np)                             &
387                                     ), splitting_factor_max                   &
388                                )
389                         IF ( splitting_factor < 2 )  CYCLE
390!
391!--                      Calculate the new number of particles.                                                           
392                         new_size = prt_count(k,j,i) + splitting_factor - 1
393!
394!--                      Cycle if maximum number of particles per grid box
395!--                      is greater than the allowed maximum number.                         
396                         IF ( new_size >= max_number_particles_per_gridbox )   & 
397                         CYCLE
398!
399!--                      Reallocate particle array if necessary.
400                         IF ( new_size > SIZE(particles) )  THEN
401                            CALL realloc_particles_array(i,j,k,new_size)
402                         ENDIF
403                         old_size  = prt_count(k,j,i)                             
404                         new_particles_gb = new_particles_gb +                 &
405                                            splitting_factor - 1
406!
407!--                      Calculate new weighting factor.
408                         particles(n)%weight_factor =                          & 
409                            particles(n)%weight_factor / splitting_factor
410                         tmp_particle = particles(n)
411!
412!--                      Create splitting_factor-1 new particles.                                                 
413                         DO  jpp = 1, splitting_factor-1
414                            grid_particles(k,j,i)%particles(jpp+old_size) =    &
415                                                                    tmp_particle         
416                         ENDDO
417!   
418!--                      Save the new number of super droplets.
419                         prt_count(k,j,i) = prt_count(k,j,i) +                 &
420                                            splitting_factor - 1
421                      ENDIF
422                   ENDDO
423                ENDDO 
424               
425                new_particles       = new_particles     + new_particles_gb
426                sum_new_particles   = sum_new_particles + new_particles_gb                   
427             ENDDO
428          ENDDO
429       ENDDO
430
431    ELSEIF ( i_splitting_mode == 3 )  THEN
432
433       DO  i = nxl, nxr
434          DO  j = nys, nyn
435             DO  k = nzb+1, nzt
436             
437!
438!--             Initialize summing variables.             
439                lwc = 0.0_wp
440                m1  = 0.0_wp
441                m2  = 0.0_wp
442                m3  = 0.0_wp
443                nr  = 0.0_wp
444                rm  = 0.0_wp 
445               
446                new_particles_gb = 0
447                number_of_particles = prt_count(k,j,i)
448                IF ( number_of_particles <= 0  .OR.                            & 
449                     ql(k,j,i) < ql_crit )  CYCLE
450                particles => grid_particles(k,j,i)%particles
451!               
452!--             Calculate moments of DSD.               
453                DO  n = 1, number_of_particles
454                   IF ( particles(n)%particle_mask  .AND.                      &
455                        particles(n)%radius >= r_min )                         &
456                   THEN
457                      nr  = nr + particles(n)%weight_factor
458                      rm  = rm + factor_volume_to_mass  *                      &
459                                 particles(n)%radius**3  *                     &
460                                 particles(n)%weight_factor
461                      IF ( isf == 1 )  THEN           
462                         diameter   = particles(n)%radius * 2.0_wp           
463                         lwc = lwc + factor_volume_to_mass *                   &
464                                     particles(n)%radius**3 *                  & 
465                                     particles(n)%weight_factor 
466                         m1  = m1 + particles(n)%weight_factor * diameter
467                         m2  = m2 + particles(n)%weight_factor * diameter**2
468                         m3  = m3 + particles(n)%weight_factor * diameter**3
469                      ENDIF     
470                   ENDIF                                           
471                ENDDO 
472
473                IF ( nr <= 0.0  .OR.  rm <= 0.0_wp )  CYCLE 
474!
475!--             Calculate mean volume averaged radius.               
476                rm = ( rm / ( nr * factor_volume_to_mass ) )**0.3333333_wp
477!
478!--             Check which function should be used to approximate the DSD.             
479                IF ( isf == 1 )  THEN
480!
481!--                Gamma size distribution to calculate 
482!--                critical weight_factor (e.g. Marshall + Palmer, 1948).
483                   zeta = m1 * m3 / m2**2
484                   mu   = MAX( ( ( 1.0_wp - zeta ) * 2.0_wp + 1.0_wp ) /       &
485                                ( zeta - 1.0_wp ), 0.0_wp                      &
486                             )   
487                   lambda = ( pirho_l * nr / lwc *                             &
488                              ( mu + 3.0_wp ) * ( mu + 2.0_wp ) *              &
489                              ( mu + 1.0_wp )                                  &                                 
490                            )**0.3333333_wp
491                   nr0 =  ( nr / (gamma( mu + 1.0_wp ) ) ) *                   &
492                          lambda**( mu + 1.0_wp ) 
493
494                   DO  n = 0, n_max-1
495                      diameter         = r_bin_mid(n) * 2.0_wp           
496                      an_spl(n) = nr0 * diameter**mu *                         &
497                                  EXP( -lambda * diameter ) *                  & 
498                                  ( r_bin(n+1) - r_bin(n) ) * 2.0_wp 
499                   ENDDO
500                ELSEIF ( isf == 2 )  THEN
501!
502!--                Lognormal size distribution to calculate critical
503!--                weight_factor (e.g. Levin, 1971, Bradley + Stow, 1974).   
504                   DO  n = 0, n_max-1
505                      an_spl(n) = nr / ( SQRT( 2.0_wp * pi ) *                 &
506                                              LOG(sigma_log) * r_bin_mid(n)    &
507                                        ) *                                    &
508                                  EXP( -( LOG( r_bin_mid(n) / rm )**2 ) /      &
509                                        ( 2.0_wp * LOG(sigma_log)**2 )         & 
510                                      ) *                                      & 
511                                  ( r_bin(n+1) - r_bin(n) )
512                   ENDDO
513                ELSEIF ( isf == 3 )  THEN
514!
515!--                Exponential size distribution to calculate critical
516!--                weight_factor (e.g. Berry + Reinhardt, 1974). 
517                   DO  n = 0, n_max-1
518                      an_spl(n) = 3.0_wp * nr * r_bin_mid(n)**2 / rm**3 *     &
519                                  EXP( - ( r_bin_mid(n)**3 / rm**3 ) ) *      &
520                                  ( r_bin(n+1) - r_bin(n) )
521                   ENDDO
522                ENDIF
523               
524!
525!--             Criterion to avoid super droplets with a weighting factor < 1.0.                                   
526                an_spl = MAX(an_spl, 1.0_wp)
527!               
528!--             Start splitting operations. Each particle is checked if it
529!--             fulfilled the splitting criterion's. In splitting mode 'gb_av'   
530!--             a critical radius (radius_split) and a splitting function must
531!--             be prescribed (see particles_par). The critical weighting factor
532!--             is calculated while appoximating a 'gamma', 'log' or 'exp'-
533!--             drop size distribution. In this mode a DSD is calculated for
534!--             every cloudy grid box. Super droplets which have a larger
535!--             radius and larger weighting factor are split into
536!--             'splitting_factor' super droplets. In this case the splitting 
537!--             factor is calculated of weighting factor of the super droplet 
538!--             and theapproximated number concentration for droplet of such
539!--             a size. Due to the splitting, the weighting factor of the 
540!--             super droplet and all created clones is reduced by the factor 
541!--             of 'splitting_facor'.
542                DO  n = 1, number_of_particles
543                   DO  np = 0, n_max-1
544                      IF ( r_bin(np) >= radius_split  .AND.                    &
545                           particles(n)%particle_mask  .AND.                   &
546                           particles(n)%radius >= r_bin(np)    .AND.           &
547                           particles(n)%radius < r_bin(np+1)   .AND.           &
548                           particles(n)%weight_factor >= an_spl(np) )          &
549                      THEN
550!
551!--                      Calculate splitting factor.
552                         splitting_factor =                                    & 
553                             MIN( INT( particles(n)%weight_factor /            &
554                                        an_spl(np)                             &
555                                     ), splitting_factor_max                   &
556                                )
557                         IF ( splitting_factor < 2 )  CYCLE
558
559!
560!--                      Calculate the new number of particles.                                                                                         
561                         new_size = prt_count(k,j,i) + splitting_factor - 1
562!
563!--                      Cycle if maximum number of particles per grid box
564!--                      is greater than the allowed maximum number.                                                 
565                         IF ( new_size >= max_number_particles_per_gridbox )   &
566                         CYCLE
567!
568!--                      Reallocate particle array if necessary.                         
569                         IF ( new_size > SIZE(particles) )  THEN
570                            CALL realloc_particles_array(i,j,k,new_size)
571                         ENDIF
572!
573!--                      Calculate new weighting factor.
574                         particles(n)%weight_factor = & 
575                            particles(n)%weight_factor / splitting_factor
576                         tmp_particle               = particles(n)
577                         old_size                   = prt_count(k,j,i)
578!
579!--                      Create splitting_factor-1 new particles.
580                         DO jpp = 1, splitting_factor-1
581                            grid_particles(k,j,i)%particles(jpp+old_size) =    &
582                               tmp_particle                 
583                         ENDDO
584!
585!--                      Save the new number of droplets for every grid box.
586                         prt_count(k,j,i)    = prt_count(k,j,i) +              &
587                                               splitting_factor - 1
588                         new_particles_gb    = new_particles_gb +              &
589                                               splitting_factor - 1                                       
590                      ENDIF
591                   ENDDO 
592                ENDDO
593
594                new_particles       = new_particles + new_particles_gb
595                sum_new_particles   = sum_new_particles + new_particles_gb                                                 
596             ENDDO
597          ENDDO
598       ENDDO
599    ENDIF
600       
601    CALL cpu_log( log_point_s(80), 'lpm_splitting', 'stop' )
602
603 END SUBROUTINE lpm_splitting
604 
Note: See TracBrowser for help on using the repository browser.