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