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

Last change on this file since 2606 was 2606, checked in by schwenkel, 6 years ago

Modified particle box location and further changes in particle model

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