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

Last change on this file since 2000 was 2000, checked in by knoop, 5 years ago

Forced header and separation lines into 80 columns

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