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

Last change on this file since 1359 was 1359, checked in by hoffmann, 7 years ago

new Lagrangian particle structure integrated

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