source: palm/trunk/SOURCE/lpm_pack_arrays.f90 @ 2516

Last change on this file since 2516 was 2417, checked in by suehring, 7 years ago

Major bugfix in modeling SGS particle speeds.

  • Property svn:keywords set to Id
File size: 12.0 KB
RevLine 
[1682]1!> @file lpm_pack_arrays.f90
[2000]2!------------------------------------------------------------------------------!
[1036]3! This file is part of PALM.
4!
[2000]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.
[1036]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!
[2101]17! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[849]20! Current revisions:
21! ------------------
[2001]22!
23!
[1321]24! Former revisions:
25! -----------------
26! $Id: lpm_pack_arrays.f90 2417 2017-09-06 15:22:27Z suehring $
[2417]27! New routine which sorts particles into particles that completed and not
28! completed the LES timestep.
29!
30! 2101 2017-01-05 16:42:31Z suehring
[1321]31!
[2001]32! 2000 2016-08-20 18:09:15Z knoop
33! Forced header and separation lines into 80 columns
34!
[1823]35! 1822 2016-04-07 07:49:42Z hoffmann
36! Tails removed. Unused variables removed.
37!
[1686]38! 1685 2015-10-08 07:32:13Z raasch
39! bugfix concerning vertical index calculation in case of ocean
40!
[1683]41! 1682 2015-10-07 23:56:08Z knoop
42! Code annotations made doxygen readable
43!
[1360]44! 1359 2014-04-11 17:15:14Z hoffmann
45! New particle structure integrated.
46! Kind definition added to all floating point numbers.
47!
[1321]48! 1320 2014-03-20 08:40:49Z raasch
[1320]49! ONLY-attribute added to USE-statements,
50! kind-parameters added to all INTEGER and REAL declaration statements,
51! kinds are defined in new module kinds,
52! comment fields (!:) to be used for variable explanations added to
53! all variable declaration statements
[849]54!
[1037]55! 1036 2012-10-22 13:43:42Z raasch
56! code put under GPL (PALM 3.9)
57!
[850]58! 849 2012-03-15 10:35:09Z raasch
59! initial revision (former part of advec_particles)
[849]60!
[850]61!
[849]62! Description:
63! ------------
[1822]64!> Pack particle arrays, which means eliminate those elements marked for
[1682]65!> deletion and move data with higher index values to these free indices.
66!> Determine the new number of particles.
[2417]67!> Moreover, particles are also sorted into groups finished and not finished
68!> its timestep.
[849]69!------------------------------------------------------------------------------!
[1682]70 MODULE lpm_pack_arrays_mod
71 
[849]72
[1320]73    USE particle_attributes,                                                   &
[1822]74        ONLY:  grid_particles, number_of_particles, offset_ocean_nzt,          &
75               particles, particle_type, prt_count
[849]76
[1359]77    PRIVATE
[2417]78    PUBLIC lpm_pack_all_arrays, lpm_pack_arrays, lpm_sort
[849]79
[1359]80    INTERFACE lpm_pack_all_arrays
81       MODULE PROCEDURE lpm_pack_all_arrays
82    END INTERFACE lpm_pack_all_arrays
[849]83
[1359]84    INTERFACE lpm_pack_arrays
85       MODULE PROCEDURE lpm_pack_arrays
86    END INTERFACE lpm_pack_arrays
87
[2417]88    INTERFACE lpm_sort
89       MODULE PROCEDURE lpm_sort
90    END INTERFACE lpm_sort
[1359]91
[2417]92
93 CONTAINS
94
[1682]95!------------------------------------------------------------------------------!
96! Description:
97! ------------
98!> @todo Missing subroutine description.
99!------------------------------------------------------------------------------!
[1359]100    SUBROUTINE lpm_pack_all_arrays
101
102       USE cpulog,                                                             &
103           ONLY:  cpu_log, log_point_s
104
105       USE indices,                                                            &
106           ONLY:  nxl, nxr, nys, nyn, nzb, nzt
107
108       USE kinds
109
110       IMPLICIT NONE
111
[1682]112       INTEGER(iwp) ::  i !<
113       INTEGER(iwp) ::  j !<
114       INTEGER(iwp) ::  k !<
[1359]115
116       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'start' )
117       DO  i = nxl, nxr
118          DO  j = nys, nyn
119             DO  k = nzb+1, nzt
120                number_of_particles = prt_count(k,j,i)
121                IF ( number_of_particles <= 0 )  CYCLE
122                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
123                CALL lpm_pack_and_sort(i,j,k)
124                prt_count(k,j,i) = number_of_particles
125             ENDDO
126          ENDDO
127       ENDDO
128       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'stop' )
129       RETURN
130
131    END SUBROUTINE lpm_pack_all_arrays
132
[1682]133!------------------------------------------------------------------------------!
134! Description:
135! ------------
136!> @todo Missing subroutine description.
137!------------------------------------------------------------------------------!
[1359]138    SUBROUTINE lpm_pack_arrays
139
140       USE kinds
141
142       IMPLICIT NONE
143
[1682]144       INTEGER(iwp) ::  n       !<
145       INTEGER(iwp) ::  nn      !<
[849]146!
[1359]147!--    Find out elements marked for deletion and move data from highest index
148!--    values to these free indices
149       nn = number_of_particles
[849]150
[1359]151       DO WHILE ( .NOT. particles(nn)%particle_mask )
152          nn = nn-1
153          IF ( nn == 0 )  EXIT
154       ENDDO
[849]155
[1359]156       IF ( nn > 0 )  THEN
157          DO  n = 1, number_of_particles
158             IF ( .NOT. particles(n)%particle_mask )  THEN
159                particles(n) = particles(nn)
160                nn = nn - 1
161                DO WHILE ( .NOT. particles(nn)%particle_mask )
162                   nn = nn-1
163                   IF ( n == nn )  EXIT
164                ENDDO
165             ENDIF
166             IF ( n == nn )  EXIT
167          ENDDO
[849]168       ENDIF
169
170!
[1359]171!--    The number of deleted particles has been determined in routines
172!--    lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz
173       number_of_particles = nn
[849]174
[1359]175    END SUBROUTINE lpm_pack_arrays
176
[1682]177!------------------------------------------------------------------------------!
178! Description:
179! ------------
180!> @todo Missing subroutine description.
181!------------------------------------------------------------------------------!
[1359]182    SUBROUTINE lpm_pack_and_sort (ip,jp,kp)
183
184      USE control_parameters,                                                  &
[1685]185          ONLY: dz
[1359]186
187      USE kinds
188
189      USE grid_variables,                                                      &
190          ONLY: ddx, ddy
191
192      IMPLICIT NONE
193
[1685]194      INTEGER(iwp), INTENT(IN) :: ip
195      INTEGER(iwp), INTENT(IN) :: jp
196      INTEGER(iwp), INTENT(IN) :: kp
[1359]197
[1685]198      INTEGER(iwp)             :: i
199      INTEGER(iwp)             :: is
200      INTEGER(iwp)             :: j
201      INTEGER(iwp)             :: k
202      INTEGER(iwp)             :: n
203      INTEGER(iwp)             :: nn
204      INTEGER(iwp)             :: m
205      INTEGER(iwp)             :: sort_index
[1359]206
[1685]207      INTEGER(iwp), DIMENSION(0:7) :: sort_count
[1359]208
209      TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles
210
[849]211       nn = 0
[1359]212       sort_count = 0
[849]213
[1359]214       DO  n = 1, number_of_particles
215          sort_index = 0
[849]216
[1359]217          IF ( particles(n)%particle_mask )  THEN
[849]218             nn = nn + 1
[1359]219             i = particles(n)%x * ddx
220             j = particles(n)%y * ddy
[1685]221             k = ( particles(n)%z + 0.5_wp * dz ) / dz + offset_ocean_nzt
[1359]222             IF ( i == ip )  sort_index = sort_index+4
223             IF ( j == jp )  sort_index = sort_index+2
224             IF ( k == kp )  sort_index = sort_index+1
225             sort_count(sort_index) = sort_count(sort_index)+1
226             m = sort_count(sort_index)
227             sort_particles(m,sort_index) = particles(n)
228             sort_particles(m,sort_index)%block_nr = sort_index
[849]229          ENDIF
230
231       ENDDO
232
[1359]233       nn = 0
234
235       DO is = 0,7
236          grid_particles(kp,jp,ip)%start_index(is) = nn + 1
237          DO n = 1,sort_count(is)
238             nn = nn+1
239             particles(nn) = sort_particles(n,is)
240          ENDDO
241          grid_particles(kp,jp,ip)%end_index(is) = nn
[849]242       ENDDO
243
[1359]244       number_of_particles = nn
245       RETURN
[849]246
[1359]247    END SUBROUTINE lpm_pack_and_sort
[849]248
[2417]249!------------------------------------------------------------------------------!
250! Description:
251! ------------
252!> Sort particles in each sub-grid box into two groups: particles that already
253!> completed the LES timestep, and particles that need further timestepping to
254!> complete the LES timestep.
255!------------------------------------------------------------------------------!
256    SUBROUTINE lpm_sort
[849]257
[2417]258       USE control_parameters,                                                 &
259           ONLY:  dt_3d
260
261       USE indices,                                                            &
262           ONLY: nxl, nxr, nys, nyn, nzb, nzt
263
264       USE kinds
265
266       IMPLICIT NONE
267
268       INTEGER(iwp) :: end_index     !< particle end index for each sub-box
269       INTEGER(iwp) :: i             !< index of particle grid box in x-direction
270       INTEGER(iwp) :: j             !< index of particle grid box in y-direction
271       INTEGER(iwp) :: k             !< index of particle grid box in z-direction
272       INTEGER(iwp) :: n             !< running index for number of particles
273       INTEGER(iwp) :: nb            !< index of subgrid boux
274       INTEGER(iwp) :: nf            !< indices for particles in each sub-box that already finalized their substeps
275       INTEGER(iwp) :: nnf           !< indices for particles in each sub-box that need further treatment
276       INTEGER(iwp) :: num_finalized !< number of particles in each sub-box that already finalized their substeps
277       INTEGER(iwp) :: start_index   !< particle start index for each sub-box
278
279       TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: sort_particles  !< temporary particle array
280
281       DO  i = nxl, nxr
282          DO  j = nys, nyn
283             DO  k = nzb+1, nzt
284
285                number_of_particles = prt_count(k,j,i)
286                IF ( number_of_particles <= 0 )  CYCLE
287
288                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
289
290                DO  nb = 0, 7
291!
292!--                Obtain start and end index for each subgrid box
293                   start_index = grid_particles(k,j,i)%start_index(nb)
294                   end_index   = grid_particles(k,j,i)%end_index(nb)
295!
296!--                Allocate temporary array used for sorting.
297                   ALLOCATE( sort_particles(start_index:end_index) )
298!
299!--                Determine number of particles already completed the LES
300!--                timestep, and write them into a temporary array.
301                   nf = start_index
302                   num_finalized = 0
303                   DO  n = start_index, end_index
304                      IF ( dt_3d - particles(n)%dt_sum < 1E-8_wp )  THEN
305                         sort_particles(nf) = particles(n)
306                         nf                 = nf + 1
307                         num_finalized      = num_finalized + 1
308                      ENDIF
309                   ENDDO
310!
311!--                Determine number of particles that not completed the LES
312!--                timestep, and write them into a temporary array.
313                   nnf = nf
314                   DO  n = start_index, end_index
315                      IF ( dt_3d - particles(n)%dt_sum > 1E-8_wp )  THEN
316                         sort_particles(nnf) = particles(n)
317                         nnf                 = nnf + 1
318                      ENDIF
319                   ENDDO
320!
321!--                Write back sorted particles
322                   particles(start_index:end_index) =                          &
323                                           sort_particles(start_index:end_index)
324!
325!--                Determine updated start_index, used to masked already
326!--                completed particles.
327                   grid_particles(k,j,i)%start_index(nb) =                     &
328                                      grid_particles(k,j,i)%start_index(nb)    &
329                                    + num_finalized
330!
331!--                Deallocate dummy array
332                   DEALLOCATE ( sort_particles )
333!
334!--                Finally, if number of non-completed particles is non zero
335!--                in any of the sub-boxes, set control flag appropriately.
336                   IF ( nnf > nf )                                             &
337                      grid_particles(k,j,i)%time_loop_done = .FALSE.
338
339                ENDDO
340             ENDDO
341          ENDDO
342       ENDDO
343
344    END SUBROUTINE lpm_sort
345
346
[1359]347 END module lpm_pack_arrays_mod
Note: See TracBrowser for help on using the repository browser.