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

Last change on this file since 1823 was 1823, checked in by hoffmann, 5 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 7.3 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-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: lpm_pack_arrays.f90 1823 2016-04-07 08:57:52Z hoffmann $
26!
27! 1822 2016-04-07 07:49:42Z hoffmann
28! Tails removed. Unused variables removed.
29!
30! 1685 2015-10-08 07:32:13Z raasch
31! bugfix concerning vertical index calculation in case of ocean
32!
33! 1682 2015-10-07 23:56:08Z knoop
34! Code annotations made doxygen readable
35!
36! 1359 2014-04-11 17:15:14Z hoffmann
37! New particle structure integrated.
38! Kind definition added to all floating point numbers.
39!
40! 1320 2014-03-20 08:40:49Z raasch
41! ONLY-attribute added to USE-statements,
42! kind-parameters added to all INTEGER and REAL declaration statements,
43! kinds are defined in new module kinds,
44! comment fields (!:) to be used for variable explanations added to
45! all variable declaration statements
46!
47! 1036 2012-10-22 13:43:42Z raasch
48! code put under GPL (PALM 3.9)
49!
50! 849 2012-03-15 10:35:09Z raasch
51! initial revision (former part of advec_particles)
52!
53!
54! Description:
55! ------------
56!> Pack particle arrays, which means eliminate those elements marked for
57!> deletion and move data with higher index values to these free indices.
58!> Determine the new number of particles.
59!------------------------------------------------------------------------------!
60 MODULE lpm_pack_arrays_mod
61 
62
63    USE particle_attributes,                                                   &
64        ONLY:  grid_particles, number_of_particles, offset_ocean_nzt,          &
65               particles, particle_type, prt_count
66
67    PRIVATE
68    PUBLIC lpm_pack_all_arrays, lpm_pack_arrays
69
70    INTERFACE lpm_pack_all_arrays
71       MODULE PROCEDURE lpm_pack_all_arrays
72    END INTERFACE lpm_pack_all_arrays
73
74    INTERFACE lpm_pack_arrays
75       MODULE PROCEDURE lpm_pack_arrays
76    END INTERFACE lpm_pack_arrays
77
78CONTAINS
79
80!------------------------------------------------------------------------------!
81! Description:
82! ------------
83!> @todo Missing subroutine description.
84!------------------------------------------------------------------------------!
85    SUBROUTINE lpm_pack_all_arrays
86
87       USE cpulog,                                                             &
88           ONLY:  cpu_log, log_point_s
89
90       USE indices,                                                            &
91           ONLY:  nxl, nxr, nys, nyn, nzb, nzt
92
93       USE kinds
94
95       IMPLICIT NONE
96
97       INTEGER(iwp) ::  i !<
98       INTEGER(iwp) ::  j !<
99       INTEGER(iwp) ::  k !<
100
101       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'start' )
102       DO  i = nxl, nxr
103          DO  j = nys, nyn
104             DO  k = nzb+1, nzt
105                number_of_particles = prt_count(k,j,i)
106                IF ( number_of_particles <= 0 )  CYCLE
107                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
108                CALL lpm_pack_and_sort(i,j,k)
109                prt_count(k,j,i) = number_of_particles
110             ENDDO
111          ENDDO
112       ENDDO
113       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'stop' )
114       RETURN
115
116    END SUBROUTINE lpm_pack_all_arrays
117
118!------------------------------------------------------------------------------!
119! Description:
120! ------------
121!> @todo Missing subroutine description.
122!------------------------------------------------------------------------------!
123    SUBROUTINE lpm_pack_arrays
124
125       USE kinds
126
127       IMPLICIT NONE
128
129       INTEGER(iwp) ::  n       !<
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    END SUBROUTINE lpm_pack_arrays
161
162!------------------------------------------------------------------------------!
163! Description:
164! ------------
165!> @todo Missing subroutine description.
166!------------------------------------------------------------------------------!
167    SUBROUTINE lpm_pack_and_sort (ip,jp,kp)
168
169      USE control_parameters,                                                  &
170          ONLY: dz
171
172      USE kinds
173
174      USE grid_variables,                                                      &
175          ONLY: ddx, ddy
176
177      IMPLICIT NONE
178
179      INTEGER(iwp), INTENT(IN) :: ip
180      INTEGER(iwp), INTENT(IN) :: jp
181      INTEGER(iwp), INTENT(IN) :: kp
182
183      INTEGER(iwp)             :: i
184      INTEGER(iwp)             :: is
185      INTEGER(iwp)             :: j
186      INTEGER(iwp)             :: k
187      INTEGER(iwp)             :: n
188      INTEGER(iwp)             :: nn
189      INTEGER(iwp)             :: m
190      INTEGER(iwp)             :: sort_index
191
192      INTEGER(iwp), DIMENSION(0:7) :: sort_count
193
194      TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles
195
196       nn = 0
197       sort_count = 0
198
199       DO  n = 1, number_of_particles
200          sort_index = 0
201
202          IF ( particles(n)%particle_mask )  THEN
203             nn = nn + 1
204             i = particles(n)%x * ddx
205             j = particles(n)%y * ddy
206             k = ( particles(n)%z + 0.5_wp * dz ) / dz + offset_ocean_nzt
207             IF ( i == ip )  sort_index = sort_index+4
208             IF ( j == jp )  sort_index = sort_index+2
209             IF ( k == kp )  sort_index = sort_index+1
210             sort_count(sort_index) = sort_count(sort_index)+1
211             m = sort_count(sort_index)
212             sort_particles(m,sort_index) = particles(n)
213             sort_particles(m,sort_index)%block_nr = sort_index
214          ENDIF
215
216       ENDDO
217
218       nn = 0
219
220       DO is = 0,7
221          grid_particles(kp,jp,ip)%start_index(is) = nn + 1
222          DO n = 1,sort_count(is)
223             nn = nn+1
224             particles(nn) = sort_particles(n,is)
225          ENDDO
226          grid_particles(kp,jp,ip)%end_index(is) = nn
227       ENDDO
228
229       number_of_particles = nn
230       RETURN
231
232    END SUBROUTINE lpm_pack_and_sort
233
234
235 END module lpm_pack_arrays_mod
Note: See TracBrowser for help on using the repository browser.