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

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

last commit documented

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