source: palm/tags/release-4.0/SOURCE/lpm_pack_arrays.f90 @ 3049

Last change on this file since 3049 was 1360, checked in by hoffmann, 10 years ago

last commit documented

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