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

Last change on this file since 1758 was 1686, checked in by raasch, 9 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 8.5 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 terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2014 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: lpm_pack_arrays.f90 1686 2015-10-08 07:49:17Z maronga $
26!
27! 1685 2015-10-08 07:32:13Z raasch
28! bugfix concerning vertical index calculation in case of ocean
29!
30! 1682 2015-10-07 23:56:08Z knoop
31! Code annotations made doxygen readable
32!
33! 1359 2014-04-11 17:15:14Z hoffmann
34! New particle structure integrated.
35! Kind definition added to all floating point numbers.
36!
37! 1320 2014-03-20 08:40:49Z raasch
38! ONLY-attribute added to USE-statements,
39! kind-parameters added to all INTEGER and REAL declaration statements,
40! kinds are defined in new module kinds,
41! comment fields (!:) to be used for variable explanations added to
42! all variable declaration statements
43!
44! 1036 2012-10-22 13:43:42Z raasch
45! code put under GPL (PALM 3.9)
46!
47! 849 2012-03-15 10:35:09Z raasch
48! initial revision (former part of advec_particles)
49!
50!
51! Description:
52! ------------
53!> Pack particle and tail arrays, which means eliminate those elements marked for
54!> deletion and move data with higher index values to these free indices.
55!> Determine the new number of particles.
56!------------------------------------------------------------------------------!
57 MODULE lpm_pack_arrays_mod
58 
59
60    USE particle_attributes,                                                   &
61        ONLY:  deleted_tails, grid_particles, new_tail_id,                     &
62               number_of_particles, number_of_tails, offset_ocean_nzt,         &
63               particles, particle_type, prt_count,                            &
64               particle_tail_coordinates, tail_mask, use_particle_tails
65
66    PRIVATE
67    PUBLIC lpm_pack_all_arrays, lpm_pack_arrays
68
69    INTERFACE lpm_pack_all_arrays
70       MODULE PROCEDURE lpm_pack_all_arrays
71    END INTERFACE lpm_pack_all_arrays
72
73    INTERFACE lpm_pack_arrays
74       MODULE PROCEDURE lpm_pack_arrays
75    END INTERFACE lpm_pack_arrays
76
77CONTAINS
78
79!------------------------------------------------------------------------------!
80! Description:
81! ------------
82!> @todo Missing subroutine description.
83!------------------------------------------------------------------------------!
84    SUBROUTINE lpm_pack_all_arrays
85
86       USE cpulog,                                                             &
87           ONLY:  cpu_log, log_point_s
88
89       USE indices,                                                            &
90           ONLY:  nxl, nxr, nys, nyn, nzb, nzt
91
92       USE kinds
93
94       IMPLICIT NONE
95
96       INTEGER(iwp) ::  i !<
97       INTEGER(iwp) ::  j !<
98       INTEGER(iwp) ::  k !<
99
100       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'start' )
101       DO  i = nxl, nxr
102          DO  j = nys, nyn
103             DO  k = nzb+1, nzt
104                number_of_particles = prt_count(k,j,i)
105                IF ( number_of_particles <= 0 )  CYCLE
106                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
107                CALL lpm_pack_and_sort(i,j,k)
108                prt_count(k,j,i) = number_of_particles
109             ENDDO
110          ENDDO
111       ENDDO
112       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'stop' )
113       RETURN
114
115    END SUBROUTINE lpm_pack_all_arrays
116
117!------------------------------------------------------------------------------!
118! Description:
119! ------------
120!> @todo Missing subroutine description.
121!------------------------------------------------------------------------------!
122    SUBROUTINE lpm_pack_arrays
123
124       USE kinds
125
126       IMPLICIT NONE
127
128       INTEGER(iwp) ::  n       !<
129       INTEGER(iwp) ::  nd      !<
130       INTEGER(iwp) ::  nn      !<
131!
132!--    Find out elements marked for deletion and move data from highest index
133!--    values to these free indices
134       nn = number_of_particles
135
136       DO WHILE ( .NOT. particles(nn)%particle_mask )
137          nn = nn-1
138          IF ( nn == 0 )  EXIT
139       ENDDO
140
141       IF ( nn > 0 )  THEN
142          DO  n = 1, number_of_particles
143             IF ( .NOT. particles(n)%particle_mask )  THEN
144                particles(n) = particles(nn)
145                nn = nn - 1
146                DO WHILE ( .NOT. particles(nn)%particle_mask )
147                   nn = nn-1
148                   IF ( n == nn )  EXIT
149                ENDDO
150             ENDIF
151             IF ( n == nn )  EXIT
152          ENDDO
153       ENDIF
154
155!
156!--    The number of deleted particles has been determined in routines
157!--    lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz
158       number_of_particles = nn
159
160!
161!-- particle tails are currently not available
162!
163!-- Handle tail array in the same way, store the new tail ids and re-assign it
164!-- to the respective particles
165!    IF ( use_particle_tails )  THEN
166!
167!       nn = 0
168!       nd = 0
169!
170!       DO  n = 1, number_of_tails
171!
172!          IF ( tail_mask(n) )  THEN
173!             nn = nn + 1
174!             particle_tail_coordinates(:,:,nn) = &
175!                                                particle_tail_coordinates(:,:,n)
176!             new_tail_id(n) = nn
177!          ELSE
178!             nd = nd + 1
179!          ENDIF
180!
181!       ENDDO
182!
183!       DO  n = 1, number_of_particles
184!          IF ( particles(n)%tail_id /= 0 )  THEN
185!             particles(n)%tail_id = new_tail_id(particles(n)%tail_id)
186!          ENDIF
187!       ENDDO
188!
189!    ENDIF
190
191!
192!-- The number of deleted tails has been determined in routines
193!-- lpm_boundary_conds and lpm_exchange_horiz
194!   number_of_tails = number_of_tails - deleted_tails
195
196
197    END SUBROUTINE lpm_pack_arrays
198
199!------------------------------------------------------------------------------!
200! Description:
201! ------------
202!> @todo Missing subroutine description.
203!------------------------------------------------------------------------------!
204    SUBROUTINE lpm_pack_and_sort (ip,jp,kp)
205
206      USE control_parameters,                                                  &
207          ONLY: dz
208
209      USE indices,                                                             &
210          ONLY: nxl, nxr, nys, nyn, nzb, nzt
211
212      USE kinds
213
214      USE grid_variables,                                                      &
215          ONLY: ddx, ddy
216
217      IMPLICIT NONE
218
219      INTEGER(iwp), INTENT(IN) :: ip
220      INTEGER(iwp), INTENT(IN) :: jp
221      INTEGER(iwp), INTENT(IN) :: kp
222
223      INTEGER(iwp)             :: i
224      INTEGER(iwp)             :: is
225      INTEGER(iwp)             :: j
226      INTEGER(iwp)             :: k
227      INTEGER(iwp)             :: n
228      INTEGER(iwp)             :: nn
229      INTEGER(iwp)             :: m
230      INTEGER(iwp)             :: sort_index
231
232      INTEGER(iwp), DIMENSION(0:7) :: sort_count
233
234      TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles
235
236       nn = 0
237       sort_count = 0
238
239       DO  n = 1, number_of_particles
240          sort_index = 0
241
242          IF ( particles(n)%particle_mask )  THEN
243             nn = nn + 1
244             i = particles(n)%x * ddx
245             j = particles(n)%y * ddy
246             k = ( particles(n)%z + 0.5_wp * dz ) / dz + offset_ocean_nzt
247             IF ( i == ip )  sort_index = sort_index+4
248             IF ( j == jp )  sort_index = sort_index+2
249             IF ( k == kp )  sort_index = sort_index+1
250             sort_count(sort_index) = sort_count(sort_index)+1
251             m = sort_count(sort_index)
252             sort_particles(m,sort_index) = particles(n)
253             sort_particles(m,sort_index)%block_nr = sort_index
254          ENDIF
255
256       ENDDO
257
258       nn = 0
259
260       DO is = 0,7
261          grid_particles(kp,jp,ip)%start_index(is) = nn + 1
262          DO n = 1,sort_count(is)
263             nn = nn+1
264             particles(nn) = sort_particles(n,is)
265          ENDDO
266          grid_particles(kp,jp,ip)%end_index(is) = nn
267       ENDDO
268
269       number_of_particles = nn
270       RETURN
271
272    END SUBROUTINE lpm_pack_and_sort
273
274
275 END module lpm_pack_arrays_mod
Note: See TracBrowser for help on using the repository browser.