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

Last change on this file since 1682 was 1682, checked in by knoop, 6 years ago

Code annotations made doxygen readable

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