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

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

Merge of branch palm4u into trunk

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