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

Last change on this file since 851 was 851, checked in by raasch, 10 years ago

Bugfix: resetting of particle_mask and tail mask moved from routine lpm_exchange_horiz to routine lpm (end of sub-timestep loop)

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