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

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

last commit documented

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