source: palm/trunk/SOURCE/lpm_exchange_horiz.f90 @ 1036

Last change on this file since 1036 was 1036, checked in by raasch, 9 years ago

code has been put under the GNU General Public License (v3)

  • Property svn:keywords set to Id
File size: 36.6 KB
Line 
1 SUBROUTINE lpm_exchange_horiz
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-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: lpm_exchange_horiz.f90 1036 2012-10-22 13:43:42Z raasch $
27!
28! 851 2012-03-15 14:32:58Z raasch
29! Bugfix: resetting of particle_mask and tail mask moved from end of this
30! routine to lpm
31!
32! 849 2012-03-15 10:35:09Z raasch
33! initial revision (former part of advec_particles)
34!
35!
36! Description:
37! ------------
38! Exchange of particles (and tails) between the subdomains.
39!------------------------------------------------------------------------------!
40
41    USE control_parameters
42    USE cpulog
43    USE grid_variables
44    USE indices
45    USE interfaces
46    USE particle_attributes
47    USE pegrid
48
49    IMPLICIT NONE
50
51    INTEGER ::  i, j, n, nn, tlength, &
52                trlp_count, trlp_count_recv, trlpt_count, trlpt_count_recv, &
53                trnp_count, trnp_count_recv, trnpt_count, trnpt_count_recv, &
54                trrp_count, trrp_count_recv, trrpt_count, trrpt_count_recv, &
55                trsp_count, trsp_count_recv, trspt_count, trspt_count_recv
56
57    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  trlpt, trnpt, trrpt, trspt
58
59    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp, trnp, trrp, trsp
60
61
62#if defined( __parallel )
63
64!
65!-- Exchange between subdomains.
66!-- As soon as one particle has moved beyond the boundary of the domain, it
67!-- is included in the relevant transfer arrays and marked for subsequent
68!-- deletion on this PE.
69!-- First sweep for crossings in x direction. Find out first the number of
70!-- particles to be transferred and allocate temporary arrays needed to store
71!-- them.
72!-- For a one-dimensional decomposition along y, no transfer is necessary,
73!-- because the particle remains on the PE, but the particle coordinate has to
74!-- be adjusted.
75    trlp_count  = 0
76    trlpt_count = 0
77    trrp_count  = 0
78    trrpt_count = 0
79
80    trlp_count_recv   = 0
81    trlpt_count_recv  = 0
82    trrp_count_recv   = 0
83    trrpt_count_recv  = 0
84
85    IF ( pdims(1) /= 1 )  THEN
86!
87!--    First calculate the storage necessary for sending and receiving the data
88       DO  n = 1, number_of_particles
89          i = ( particles(n)%x + 0.5 * dx ) * ddx
90!
91!--       Above calculation does not work for indices less than zero
92          IF ( particles(n)%x < -0.5 * dx )  i = -1
93
94          IF ( i < nxl )  THEN
95             trlp_count = trlp_count + 1
96             IF ( particles(n)%tail_id /= 0 )  trlpt_count = trlpt_count + 1
97          ELSEIF ( i > nxr )  THEN
98             trrp_count = trrp_count + 1
99             IF ( particles(n)%tail_id /= 0 )  trrpt_count = trrpt_count + 1
100          ENDIF
101       ENDDO
102
103       IF ( trlp_count  == 0 )  trlp_count  = 1
104       IF ( trlpt_count == 0 )  trlpt_count = 1
105       IF ( trrp_count  == 0 )  trrp_count  = 1
106       IF ( trrpt_count == 0 )  trrpt_count = 1
107
108       ALLOCATE( trlp(trlp_count), trrp(trrp_count) )
109
110       trlp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
111                             0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
112                             0.0, 0, 0, 0, 0 )
113       trrp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
114                             0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
115                             0.0, 0, 0, 0, 0 )
116
117       IF ( use_particle_tails )  THEN
118          ALLOCATE( trlpt(maximum_number_of_tailpoints,5,trlpt_count), &
119                    trrpt(maximum_number_of_tailpoints,5,trrpt_count) )
120          tlength = maximum_number_of_tailpoints * 5
121       ENDIF
122
123       trlp_count  = 0
124       trlpt_count = 0
125       trrp_count  = 0
126       trrpt_count = 0
127
128    ENDIF
129
130    DO  n = 1, number_of_particles
131
132       nn = particles(n)%tail_id
133
134       i = ( particles(n)%x + 0.5 * dx ) * ddx
135!
136!--    Above calculation does not work for indices less than zero
137       IF ( particles(n)%x < - 0.5 * dx )  i = -1
138
139       IF ( i <  nxl )  THEN
140          IF ( i < 0 )  THEN
141!
142!--          Apply boundary condition along x
143             IF ( ibc_par_lr == 0 )  THEN
144!
145!--             Cyclic condition
146                IF ( pdims(1) == 1 )  THEN
147                   particles(n)%x        = ( nx + 1 ) * dx + particles(n)%x
148                   particles(n)%origin_x = ( nx + 1 ) * dx + &
149                                           particles(n)%origin_x
150                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
151                      = particles(n)%tailpoints
152                      particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx &
153                                        + particle_tail_coordinates(1:i,1,nn)
154                   ENDIF
155                ELSE
156                   trlp_count = trlp_count + 1
157                   trlp(trlp_count)   = particles(n)
158                   trlp(trlp_count)%x = ( nx + 1 ) * dx + trlp(trlp_count)%x
159                   trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x + &
160                                               ( nx + 1 ) * dx
161                   particle_mask(n)  = .FALSE.
162                   deleted_particles = deleted_particles + 1
163
164                   IF ( trlp(trlp_count)%x >= (nx + 0.5)* dx - 1.0E-12 ) THEN
165                      trlp(trlp_count)%x = trlp(trlp_count)%x - 1.0E-10
166!++ why is 1 subtracted in next statement???
167                      trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x - 1
168                   ENDIF
169
170                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
171                      trlpt_count = trlpt_count + 1
172                      trlpt(:,:,trlpt_count) = particle_tail_coordinates(:,:,nn)
173                      trlpt(:,1,trlpt_count) = ( nx + 1 ) * dx + &
174                                               trlpt(:,1,trlpt_count)
175                      tail_mask(nn) = .FALSE.
176                      deleted_tails = deleted_tails + 1
177                   ENDIF
178                ENDIF
179
180             ELSEIF ( ibc_par_lr == 1 )  THEN
181!
182!--             Particle absorption
183                particle_mask(n) = .FALSE.
184                deleted_particles = deleted_particles + 1
185                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
186                   tail_mask(nn) = .FALSE.
187                   deleted_tails = deleted_tails + 1
188                ENDIF
189
190             ELSEIF ( ibc_par_lr == 2 )  THEN
191!
192!--             Particle reflection
193                particles(n)%x       = -particles(n)%x
194                particles(n)%speed_x = -particles(n)%speed_x
195
196             ENDIF
197          ELSE
198!
199!--          Store particle data in the transfer array, which will be send
200!--          to the neighbouring PE
201             trlp_count = trlp_count + 1
202             trlp(trlp_count) = particles(n)
203             particle_mask(n) = .FALSE.
204             deleted_particles = deleted_particles + 1
205
206             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
207                trlpt_count = trlpt_count + 1
208                trlpt(:,:,trlpt_count) = particle_tail_coordinates(:,:,nn)
209                tail_mask(nn) = .FALSE.
210                deleted_tails = deleted_tails + 1
211             ENDIF
212         ENDIF
213
214       ELSEIF ( i > nxr )  THEN
215          IF ( i > nx )  THEN
216!
217!--          Apply boundary condition along x
218             IF ( ibc_par_lr == 0 )  THEN
219!
220!--             Cyclic condition
221                IF ( pdims(1) == 1 )  THEN
222                   particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
223                   particles(n)%origin_x = particles(n)%origin_x - &
224                                           ( nx + 1 ) * dx
225                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
226                      i = particles(n)%tailpoints
227                      particle_tail_coordinates(1:i,1,nn) = - ( nx+1 ) * dx &
228                                           + particle_tail_coordinates(1:i,1,nn)
229                   ENDIF
230                ELSE
231                   trrp_count = trrp_count + 1
232                   trrp(trrp_count) = particles(n)
233                   trrp(trrp_count)%x = trrp(trrp_count)%x - ( nx + 1 ) * dx
234                   trrp(trrp_count)%origin_x = trrp(trrp_count)%origin_x - &
235                                               ( nx + 1 ) * dx
236                   particle_mask(n) = .FALSE.
237                   deleted_particles = deleted_particles + 1
238
239                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
240                      trrpt_count = trrpt_count + 1
241                      trrpt(:,:,trrpt_count) = particle_tail_coordinates(:,:,nn)
242                      trrpt(:,1,trrpt_count) = trrpt(:,1,trrpt_count) - &
243                                               ( nx + 1 ) * dx
244                      tail_mask(nn) = .FALSE.
245                      deleted_tails = deleted_tails + 1
246                   ENDIF
247                ENDIF
248
249             ELSEIF ( ibc_par_lr == 1 )  THEN
250!
251!--             Particle absorption
252                particle_mask(n) = .FALSE.
253                deleted_particles = deleted_particles + 1
254                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
255                   tail_mask(nn) = .FALSE.
256                   deleted_tails = deleted_tails + 1
257                ENDIF
258
259             ELSEIF ( ibc_par_lr == 2 )  THEN
260!
261!--             Particle reflection
262                particles(n)%x       = 2 * ( nx * dx ) - particles(n)%x
263                particles(n)%speed_x = -particles(n)%speed_x
264
265             ENDIF
266          ELSE
267!
268!--          Store particle data in the transfer array, which will be send
269!--          to the neighbouring PE
270             trrp_count = trrp_count + 1
271             trrp(trrp_count) = particles(n)
272             particle_mask(n) = .FALSE.
273             deleted_particles = deleted_particles + 1
274
275             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
276                trrpt_count = trrpt_count + 1
277                trrpt(:,:,trrpt_count) = particle_tail_coordinates(:,:,nn)
278                tail_mask(nn) = .FALSE.
279                deleted_tails = deleted_tails + 1
280             ENDIF
281          ENDIF
282
283       ENDIF
284    ENDDO
285
286!
287!-- Send left boundary, receive right boundary (but first exchange how many
288!-- and check, if particle storage must be extended)
289    IF ( pdims(1) /= 1 )  THEN
290
291       CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'start' )
292       CALL MPI_SENDRECV( trlp_count,      1, MPI_INTEGER, pleft,  0, &
293                          trrp_count_recv, 1, MPI_INTEGER, pright, 0, &
294                          comm2d, status, ierr )
295
296       IF ( number_of_particles + trrp_count_recv > &
297            maximum_number_of_particles )           &
298       THEN
299          IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
300              message_string = 'maximum_number_of_particles ' //    &
301                               'needs to be increased ' //          &
302                               '&but this is not allowed with ' //  &
303                               'netcdf-data_format < 3'
304             CALL message( 'lpm_exch_horiz', 'PA0146', 2, 2, -1, 6, 1 )
305          ELSE
306             CALL lpm_extend_particle_array( trrp_count_recv )
307          ENDIF
308       ENDIF
309
310       CALL MPI_SENDRECV( trlp(1)%age, trlp_count, mpi_particle_type,     &
311                          pleft, 1, particles(number_of_particles+1)%age, &
312                          trrp_count_recv, mpi_particle_type, pright, 1,  &
313                          comm2d, status, ierr )
314
315       IF ( use_particle_tails )  THEN
316
317          CALL MPI_SENDRECV( trlpt_count,      1, MPI_INTEGER, pleft,  0, &
318                             trrpt_count_recv, 1, MPI_INTEGER, pright, 0, &
319                             comm2d, status, ierr )
320
321          IF ( number_of_tails+trrpt_count_recv > maximum_number_of_tails ) &
322          THEN
323             IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
324                message_string = 'maximum_number_of_tails ' //   &
325                                 'needs to be increased ' //     &
326                                 '&but this is not allowed wi'// &
327                                 'th netcdf_data_format < 3'
328                CALL message( 'lpm_exch_horiz', 'PA0147', 2, 2, -1, 6, 1 )
329             ELSE
330                CALL lpm_extend_tail_array( trrpt_count_recv )
331             ENDIF
332          ENDIF
333
334          CALL MPI_SENDRECV( trlpt(1,1,1), trlpt_count*tlength, MPI_REAL,      &
335                             pleft, 1,                                         &
336                             particle_tail_coordinates(1,1,number_of_tails+1), &
337                             trrpt_count_recv*tlength, MPI_REAL, pright, 1,    &
338                             comm2d, status, ierr )
339!
340!--       Update the tail ids for the transferred particles
341          nn = number_of_tails
342          DO  n = number_of_particles+1, number_of_particles+trrp_count_recv
343             IF ( particles(n)%tail_id /= 0 )  THEN
344                nn = nn + 1
345                particles(n)%tail_id = nn
346             ENDIF
347          ENDDO
348
349       ENDIF
350
351       number_of_particles = number_of_particles + trrp_count_recv
352       number_of_tails     = number_of_tails     + trrpt_count_recv
353
354!
355!--    Send right boundary, receive left boundary
356       CALL MPI_SENDRECV( trrp_count,      1, MPI_INTEGER, pright, 0, &
357                          trlp_count_recv, 1, MPI_INTEGER, pleft,  0, &
358                          comm2d, status, ierr )
359
360       IF ( number_of_particles + trlp_count_recv > &
361            maximum_number_of_particles )           &
362       THEN
363          IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
364             message_string = 'maximum_number_of_particles ' //  &
365                              'needs to be increased ' //        &
366                              '&but this is not allowed with '// &
367                              'netcdf_data_format < 3'
368             CALL message( 'lpm_exch_horiz', 'PA0146', 2, 2, -1, 6, 1 )
369          ELSE
370             CALL lpm_extend_particle_array( trlp_count_recv )
371          ENDIF
372       ENDIF
373
374       CALL MPI_SENDRECV( trrp(1)%age, trrp_count, mpi_particle_type,      &
375                          pright, 1, particles(number_of_particles+1)%age, &
376                          trlp_count_recv, mpi_particle_type, pleft, 1,    &
377                          comm2d, status, ierr )
378
379       IF ( use_particle_tails )  THEN
380
381          CALL MPI_SENDRECV( trrpt_count,      1, MPI_INTEGER, pright, 0, &
382                             trlpt_count_recv, 1, MPI_INTEGER, pleft,  0, &
383                             comm2d, status, ierr )
384
385          IF ( number_of_tails+trlpt_count_recv > maximum_number_of_tails ) &
386          THEN
387             IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
388                message_string = 'maximum_number_of_tails ' //   &
389                                 'needs to be increased ' //     &
390                                 '&but this is not allowed wi'// &
391                                 'th netcdf_data_format < 3'
392                CALL message( 'lpm_exch_horiz', 'PA0147', 2, 2, -1, 6, 1 ) 
393             ELSE
394                CALL lpm_extend_tail_array( trlpt_count_recv )
395             ENDIF
396          ENDIF
397
398          CALL MPI_SENDRECV( trrpt(1,1,1), trrpt_count*tlength, MPI_REAL,      &
399                             pright, 1,                                        &
400                             particle_tail_coordinates(1,1,number_of_tails+1), &
401                             trlpt_count_recv*tlength, MPI_REAL, pleft, 1,     &
402                             comm2d, status, ierr )
403!
404!--       Update the tail ids for the transferred particles
405          nn = number_of_tails
406          DO  n = number_of_particles+1, number_of_particles+trlp_count_recv
407             IF ( particles(n)%tail_id /= 0 )  THEN
408                nn = nn + 1
409                particles(n)%tail_id = nn
410             ENDIF
411          ENDDO
412
413       ENDIF
414
415       number_of_particles = number_of_particles + trlp_count_recv
416       number_of_tails     = number_of_tails     + trlpt_count_recv
417
418       IF ( use_particle_tails )  THEN
419          DEALLOCATE( trlpt, trrpt )
420       ENDIF
421       DEALLOCATE( trlp, trrp ) 
422
423       CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'pause' )
424
425    ENDIF
426
427
428!
429!-- Check whether particles have crossed the boundaries in y direction. Note
430!-- that this case can also apply to particles that have just been received
431!-- from the adjacent right or left PE.
432!-- Find out first the number of particles to be transferred and allocate
433!-- temporary arrays needed to store them.
434!-- For a one-dimensional decomposition along x, no transfer is necessary,
435!-- because the particle remains on the PE.
436    trsp_count  = 0
437    trspt_count = 0
438    trnp_count  = 0
439    trnpt_count = 0
440
441    trsp_count_recv   = 0
442    trspt_count_recv  = 0
443    trnp_count_recv   = 0
444    trnpt_count_recv  = 0
445
446    IF ( pdims(2) /= 1 )  THEN
447!
448!--    First calculate the storage necessary for sending and receiving the
449!--    data
450       DO  n = 1, number_of_particles
451          IF ( particle_mask(n) )  THEN
452             j = ( particles(n)%y + 0.5 * dy ) * ddy
453!
454!--          Above calculation does not work for indices less than zero
455             IF ( particles(n)%y < -0.5 * dy )  j = -1
456
457             IF ( j < nys )  THEN
458                trsp_count = trsp_count + 1
459                IF ( particles(n)%tail_id /= 0 )  trspt_count = trspt_count+1
460             ELSEIF ( j > nyn )  THEN
461                trnp_count = trnp_count + 1
462                IF ( particles(n)%tail_id /= 0 )  trnpt_count = trnpt_count+1
463             ENDIF
464          ENDIF
465       ENDDO
466
467       IF ( trsp_count  == 0 )  trsp_count  = 1
468       IF ( trspt_count == 0 )  trspt_count = 1
469       IF ( trnp_count  == 0 )  trnp_count  = 1
470       IF ( trnpt_count == 0 )  trnpt_count = 1
471
472       ALLOCATE( trsp(trsp_count), trnp(trnp_count) )
473
474       trsp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
475                             0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
476                             0.0, 0, 0, 0, 0 )
477       trnp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
478                             0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
479                             0.0, 0, 0, 0, 0 )
480
481       IF ( use_particle_tails )  THEN
482          ALLOCATE( trspt(maximum_number_of_tailpoints,5,trspt_count), &
483                    trnpt(maximum_number_of_tailpoints,5,trnpt_count) )
484          tlength = maximum_number_of_tailpoints * 5
485       ENDIF
486
487       trsp_count  = 0
488       trspt_count = 0
489       trnp_count  = 0
490       trnpt_count = 0
491
492    ENDIF
493
494    DO  n = 1, number_of_particles
495
496       nn = particles(n)%tail_id
497!
498!--    Only those particles that have not been marked as 'deleted' may be
499!--    moved.
500       IF ( particle_mask(n) )  THEN
501          j = ( particles(n)%y + 0.5 * dy ) * ddy
502!
503!--       Above calculation does not work for indices less than zero
504          IF ( particles(n)%y < -0.5 * dy )  j = -1
505
506          IF ( j < nys )  THEN
507             IF ( j < 0 )  THEN
508!
509!--             Apply boundary condition along y
510                IF ( ibc_par_ns == 0 )  THEN
511!
512!--                Cyclic condition
513                   IF ( pdims(2) == 1 )  THEN
514                      particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
515                      particles(n)%origin_y = ( ny + 1 ) * dy + &
516                                              particles(n)%origin_y
517                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
518                         i = particles(n)%tailpoints
519                         particle_tail_coordinates(1:i,2,nn) = ( ny+1 ) * dy&
520                                        + particle_tail_coordinates(1:i,2,nn)
521                      ENDIF
522                   ELSE
523                      trsp_count = trsp_count + 1
524                      trsp(trsp_count) = particles(n)
525                      trsp(trsp_count)%y = ( ny + 1 ) * dy + &
526                                           trsp(trsp_count)%y
527                      trsp(trsp_count)%origin_y = trsp(trsp_count)%origin_y &
528                                                  + ( ny + 1 ) * dy
529                      particle_mask(n) = .FALSE.
530                      deleted_particles = deleted_particles + 1
531
532                      IF ( trsp(trsp_count)%y >= (ny+0.5)* dy - 1.0E-12 ) THEN
533                         trsp(trsp_count)%y = trsp(trsp_count)%y - 1.0E-10
534!++ why is 1 subtracted in next statement???
535                         trsp(trsp_count)%origin_y =                        &
536                                                   trsp(trsp_count)%origin_y - 1
537                      ENDIF
538
539                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
540                         trspt_count = trspt_count + 1
541                         trspt(:,:,trspt_count) = &
542                                               particle_tail_coordinates(:,:,nn)
543                         trspt(:,2,trspt_count) = ( ny + 1 ) * dy + &
544                                                  trspt(:,2,trspt_count)
545                         tail_mask(nn) = .FALSE.
546                         deleted_tails = deleted_tails + 1
547                      ENDIF
548                   ENDIF
549
550                ELSEIF ( ibc_par_ns == 1 )  THEN
551!
552!--                Particle absorption
553                   particle_mask(n) = .FALSE.
554                   deleted_particles = deleted_particles + 1
555                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
556                      tail_mask(nn) = .FALSE.
557                      deleted_tails = deleted_tails + 1
558                   ENDIF
559
560                ELSEIF ( ibc_par_ns == 2 )  THEN
561!
562!--                Particle reflection
563                   particles(n)%y       = -particles(n)%y
564                   particles(n)%speed_y = -particles(n)%speed_y
565
566                ENDIF
567             ELSE
568!
569!--             Store particle data in the transfer array, which will be send
570!--             to the neighbouring PE
571                trsp_count = trsp_count + 1
572                trsp(trsp_count) = particles(n)
573                particle_mask(n) = .FALSE.
574                deleted_particles = deleted_particles + 1
575
576                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
577                   trspt_count = trspt_count + 1
578                   trspt(:,:,trspt_count) = particle_tail_coordinates(:,:,nn)
579                   tail_mask(nn) = .FALSE.
580                   deleted_tails = deleted_tails + 1
581                ENDIF
582             ENDIF
583
584          ELSEIF ( j > nyn )  THEN
585             IF ( j > ny )  THEN
586!
587!--             Apply boundary condition along x
588                IF ( ibc_par_ns == 0 )  THEN
589!
590!--                Cyclic condition
591                   IF ( pdims(2) == 1 )  THEN
592                      particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
593                      particles(n)%origin_y = particles(n)%origin_y - &
594                                              ( ny + 1 ) * dy
595                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
596                         i = particles(n)%tailpoints
597                         particle_tail_coordinates(1:i,2,nn) = - (ny+1) * dy &
598                                           + particle_tail_coordinates(1:i,2,nn)
599                      ENDIF
600                   ELSE
601                      trnp_count = trnp_count + 1
602                      trnp(trnp_count) = particles(n)
603                      trnp(trnp_count)%y = trnp(trnp_count)%y - &
604                                           ( ny + 1 ) * dy
605                      trnp(trnp_count)%origin_y = trnp(trnp_count)%origin_y &
606                                                  - ( ny + 1 ) * dy
607                      particle_mask(n) = .FALSE.
608                      deleted_particles = deleted_particles + 1
609
610                      IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
611                         trnpt_count = trnpt_count + 1
612                         trnpt(:,:,trnpt_count) = &
613                                               particle_tail_coordinates(:,:,nn)
614                         trnpt(:,2,trnpt_count) = trnpt(:,2,trnpt_count) - &
615                                                  ( ny + 1 ) * dy
616                         tail_mask(nn) = .FALSE.
617                         deleted_tails = deleted_tails + 1
618                      ENDIF
619                   ENDIF
620
621                ELSEIF ( ibc_par_ns == 1 )  THEN
622!
623!--                Particle absorption
624                   particle_mask(n) = .FALSE.
625                   deleted_particles = deleted_particles + 1
626                   IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
627                      tail_mask(nn) = .FALSE.
628                      deleted_tails = deleted_tails + 1
629                   ENDIF
630
631                ELSEIF ( ibc_par_ns == 2 )  THEN
632!
633!--                Particle reflection
634                   particles(n)%y       = 2 * ( ny * dy ) - particles(n)%y
635                   particles(n)%speed_y = -particles(n)%speed_y
636
637                ENDIF
638             ELSE
639!
640!--             Store particle data in the transfer array, which will be send
641!--             to the neighbouring PE
642                trnp_count = trnp_count + 1
643                trnp(trnp_count) = particles(n)
644                particle_mask(n) = .FALSE.
645                deleted_particles = deleted_particles + 1
646
647                IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
648                   trnpt_count = trnpt_count + 1
649                   trnpt(:,:,trnpt_count) = particle_tail_coordinates(:,:,nn)
650                   tail_mask(nn) = .FALSE.
651                   deleted_tails = deleted_tails + 1
652                ENDIF
653             ENDIF
654
655          ENDIF
656       ENDIF
657    ENDDO
658
659!
660!-- Send front boundary, receive back boundary (but first exchange how many
661!-- and check, if particle storage must be extended)
662    IF ( pdims(2) /= 1 )  THEN
663
664       CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'continue' )
665       CALL MPI_SENDRECV( trsp_count,      1, MPI_INTEGER, psouth, 0, &
666                          trnp_count_recv, 1, MPI_INTEGER, pnorth, 0, &
667                          comm2d, status, ierr )
668
669       IF ( number_of_particles + trnp_count_recv > &
670            maximum_number_of_particles )           &
671       THEN
672          IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
673             message_string = 'maximum_number_of_particles ' //  &
674                              'needs to be increased ' //        &
675                              '&but this is not allowed with '// &
676                              'netcdf_data_format < 3'
677             CALL message( 'lpm_exch_horiz', 'PA0146', 2, 2, -1, 6, 1 ) 
678          ELSE
679             CALL lpm_extend_particle_array( trnp_count_recv )
680          ENDIF
681       ENDIF
682
683       CALL MPI_SENDRECV( trsp(1)%age, trsp_count, mpi_particle_type,      &
684                          psouth, 1, particles(number_of_particles+1)%age, &
685                          trnp_count_recv, mpi_particle_type, pnorth, 1,   &
686                          comm2d, status, ierr )
687
688       IF ( use_particle_tails )  THEN
689
690          CALL MPI_SENDRECV( trspt_count,      1, MPI_INTEGER, psouth, 0, &
691                             trnpt_count_recv, 1, MPI_INTEGER, pnorth, 0, &
692                             comm2d, status, ierr )
693
694          IF ( number_of_tails+trnpt_count_recv > maximum_number_of_tails ) &
695          THEN
696             IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
697                message_string = 'maximum_number_of_tails ' //    &
698                                 'needs to be increased ' //      &
699                                 '&but this is not allowed wi' // &
700                                 'th netcdf_data_format < 3'
701                CALL message( 'lpm_exch_horiz', 'PA0147', 2, 2, -1, 6, 1 ) 
702             ELSE
703                CALL lpm_extend_tail_array( trnpt_count_recv )
704             ENDIF
705          ENDIF
706
707          CALL MPI_SENDRECV( trspt(1,1,1), trspt_count*tlength, MPI_REAL,      &
708                             psouth, 1,                                        &
709                             particle_tail_coordinates(1,1,number_of_tails+1), &
710                             trnpt_count_recv*tlength, MPI_REAL, pnorth, 1,    &
711                             comm2d, status, ierr )
712
713!
714!--       Update the tail ids for the transferred particles
715          nn = number_of_tails
716          DO  n = number_of_particles+1, number_of_particles+trnp_count_recv
717             IF ( particles(n)%tail_id /= 0 )  THEN
718                nn = nn + 1
719                particles(n)%tail_id = nn
720             ENDIF
721          ENDDO
722
723       ENDIF
724
725       number_of_particles = number_of_particles + trnp_count_recv
726       number_of_tails     = number_of_tails     + trnpt_count_recv
727
728!
729!--    Send back boundary, receive front boundary
730       CALL MPI_SENDRECV( trnp_count,      1, MPI_INTEGER, pnorth, 0, &
731                          trsp_count_recv, 1, MPI_INTEGER, psouth, 0, &
732                          comm2d, status, ierr )
733
734       IF ( number_of_particles + trsp_count_recv > &
735            maximum_number_of_particles )           &
736       THEN
737          IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
738             message_string = 'maximum_number_of_particles ' //   &
739                              'needs to be increased ' //         &
740                              '&but this is not allowed with ' // &
741                              'netcdf_data_format < 3'
742            CALL message( 'lpm_exch_horiz', 'PA0146', 2, 2, -1, 6, 1 ) 
743          ELSE
744             CALL lpm_extend_particle_array( trsp_count_recv )
745          ENDIF
746       ENDIF
747
748       CALL MPI_SENDRECV( trnp(1)%age, trnp_count, mpi_particle_type,      &
749                          pnorth, 1, particles(number_of_particles+1)%age, &
750                          trsp_count_recv, mpi_particle_type, psouth, 1,   &
751                          comm2d, status, ierr )
752
753       IF ( use_particle_tails )  THEN
754
755          CALL MPI_SENDRECV( trnpt_count,      1, MPI_INTEGER, pnorth, 0, &
756                             trspt_count_recv, 1, MPI_INTEGER, psouth, 0, &
757                             comm2d, status, ierr )
758
759          IF ( number_of_tails+trspt_count_recv > maximum_number_of_tails ) &
760          THEN
761             IF ( netcdf_output  .AND.  netcdf_data_format < 3 )  THEN
762                message_string = 'maximum_number_of_tails ' //   &
763                                 'needs to be increased ' //     &
764                                 '&but this is not allowed wi'// &
765                                 'th NetCDF output switched on'
766                CALL message( 'lpm_exch_horiz', 'PA0147', 2, 2, -1, 6, 1 )
767             ELSE
768                CALL lpm_extend_tail_array( trspt_count_recv )
769             ENDIF
770          ENDIF
771
772          CALL MPI_SENDRECV( trnpt(1,1,1), trnpt_count*tlength, MPI_REAL,      &
773                             pnorth, 1,                                        &
774                             particle_tail_coordinates(1,1,number_of_tails+1), &
775                             trspt_count_recv*tlength, MPI_REAL, psouth, 1,    &
776                             comm2d, status, ierr )
777!
778!--       Update the tail ids for the transferred particles
779          nn = number_of_tails
780          DO  n = number_of_particles+1, number_of_particles+trsp_count_recv
781             IF ( particles(n)%tail_id /= 0 )  THEN
782                nn = nn + 1
783                particles(n)%tail_id = nn
784             ENDIF
785          ENDDO
786
787       ENDIF
788
789       number_of_particles = number_of_particles + trsp_count_recv
790       number_of_tails     = number_of_tails     + trspt_count_recv
791
792       IF ( use_particle_tails )  THEN
793          DEALLOCATE( trspt, trnpt )
794       ENDIF
795       DEALLOCATE( trsp, trnp )
796
797       CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'stop' )
798
799    ENDIF
800
801#else
802
803!
804!-- Apply boundary conditions
805    DO  n = 1, number_of_particles
806
807       nn = particles(n)%tail_id
808
809       IF ( particles(n)%x < -0.5 * dx )  THEN
810
811          IF ( ibc_par_lr == 0 )  THEN
812!
813!--          Cyclic boundary. Relevant coordinate has to be changed.
814             particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
815             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
816                i = particles(n)%tailpoints
817                particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx + &
818                                             particle_tail_coordinates(1:i,1,nn)
819             ENDIF
820          ELSEIF ( ibc_par_lr == 1 )  THEN
821!
822!--          Particle absorption
823             particle_mask(n) = .FALSE.
824             deleted_particles = deleted_particles + 1
825             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
826                tail_mask(nn) = .FALSE.
827                deleted_tails = deleted_tails + 1
828             ENDIF
829          ELSEIF ( ibc_par_lr == 2 )  THEN
830!
831!--          Particle reflection
832             particles(n)%x       = -dx - particles(n)%x
833             particles(n)%speed_x = -particles(n)%speed_x
834          ENDIF
835
836       ELSEIF ( particles(n)%x >= ( nx + 0.5 ) * dx )  THEN
837
838          IF ( ibc_par_lr == 0 )  THEN
839!
840!--          Cyclic boundary. Relevant coordinate has to be changed.
841             particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
842             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
843                i = particles(n)%tailpoints
844                particle_tail_coordinates(1:i,1,nn) = - ( nx + 1 ) * dx + &
845                                             particle_tail_coordinates(1:i,1,nn)
846             ENDIF
847          ELSEIF ( ibc_par_lr == 1 )  THEN
848!
849!--          Particle absorption
850             particle_mask(n) = .FALSE.
851             deleted_particles = deleted_particles + 1
852             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
853                tail_mask(nn) = .FALSE.
854                deleted_tails = deleted_tails + 1
855             ENDIF
856          ELSEIF ( ibc_par_lr == 2 )  THEN
857!
858!--          Particle reflection
859             particles(n)%x       = ( nx + 1 ) * dx - particles(n)%x
860             particles(n)%speed_x = -particles(n)%speed_x
861          ENDIF
862
863       ENDIF
864
865       IF ( particles(n)%y < -0.5 * dy )  THEN
866
867          IF ( ibc_par_ns == 0 )  THEN
868!
869!--          Cyclic boundary. Relevant coordinate has to be changed.
870             particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
871             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
872                i = particles(n)%tailpoints
873                particle_tail_coordinates(1:i,2,nn) = ( ny + 1 ) * dy + &
874                                             particle_tail_coordinates(1:i,2,nn)
875             ENDIF
876          ELSEIF ( ibc_par_ns == 1 )  THEN
877!
878!--          Particle absorption
879             particle_mask(n) = .FALSE.
880             deleted_particles = deleted_particles + 1
881             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
882                tail_mask(nn) = .FALSE.
883                deleted_tails = deleted_tails + 1
884             ENDIF
885          ELSEIF ( ibc_par_ns == 2 )  THEN
886!
887!--          Particle reflection
888             particles(n)%y       = -dy - particles(n)%y
889             particles(n)%speed_y = -particles(n)%speed_y
890          ENDIF
891
892       ELSEIF ( particles(n)%y >= ( ny + 0.5 ) * dy )  THEN
893
894          IF ( ibc_par_ns == 0 )  THEN
895!
896!--          Cyclic boundary. Relevant coordinate has to be changed.
897             particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
898             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
899                i = particles(n)%tailpoints
900                particle_tail_coordinates(1:i,2,nn) = - ( ny + 1 ) * dy + &
901                                             particle_tail_coordinates(1:i,2,nn)
902             ENDIF
903          ELSEIF ( ibc_par_ns == 1 )  THEN
904!
905!--          Particle absorption
906             particle_mask(n) = .FALSE.
907             deleted_particles = deleted_particles + 1
908             IF ( use_particle_tails  .AND.  nn /= 0 )  THEN
909                tail_mask(nn) = .FALSE.
910                deleted_tails = deleted_tails + 1
911             ENDIF
912          ELSEIF ( ibc_par_ns == 2 )  THEN
913!
914!--          Particle reflection
915             particles(n)%y       = ( ny + 1 ) * dy - particles(n)%y
916             particles(n)%speed_y = -particles(n)%speed_y
917          ENDIF
918
919       ENDIF
920    ENDDO
921
922#endif
923
924!
925!-- Accumulate the number of particles transferred between the subdomains
926#if defined( __parallel )
927    trlp_count_sum      = trlp_count_sum      + trlp_count
928    trlp_count_recv_sum = trlp_count_recv_sum + trlp_count_recv
929    trrp_count_sum      = trrp_count_sum      + trrp_count
930    trrp_count_recv_sum = trrp_count_recv_sum + trrp_count_recv
931    trsp_count_sum      = trsp_count_sum      + trsp_count
932    trsp_count_recv_sum = trsp_count_recv_sum + trsp_count_recv
933    trnp_count_sum      = trnp_count_sum      + trnp_count
934    trnp_count_recv_sum = trnp_count_recv_sum + trnp_count_recv
935#endif
936
937
938 END SUBROUTINE lpm_exchange_horiz
Note: See TracBrowser for help on using the repository browser.