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

Last change on this file since 2053 was 2001, checked in by knoop, 8 years ago

last commit documented

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