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

Last change on this file since 858 was 852, checked in by raasch, 13 years ago

last commit documented

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