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

Last change on this file since 3436 was 3241, checked in by raasch, 6 years ago

various changes to avoid compiler warnings (mainly removal of unused variables)

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