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

Last change on this file since 1318 was 1318, checked in by raasch, 8 years ago

former files/routines cpu_log and cpu_statistics combined to one module,
which also includes the former data module cpulog from the modules-file,
module interfaces removed

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