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

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

Changed:


Original routine advec_particles split into several new subroutines and renamed
lpm.
init_particles renamed lpm_init
user_advec_particles renamed user_lpm_advec,
particle_boundary_conds renamed lpm_boundary_conds,
set_particle_attributes renamed lpm_set_attributes,
user_init_particles renamed user_lpm_init,
user_particle_attributes renamed user_lpm_set_attributes
(Makefile, lpm_droplet_collision, lpm_droplet_condensation, init_3d_model, modules, palm, read_var_list, time_integration, write_var_list, deleted: advec_particles, init_particles, particle_boundary_conds, set_particle_attributes, user_advec_particles, user_init_particles, user_particle_attributes, new: lpm, lpm_advec, lpm_boundary_conds, lpm_calc_liquid_water_content, lpm_data_output_particles, lpm_droplet_collision, lpm_drollet_condensation, lpm_exchange_horiz, lpm_extend_particle_array, lpm_extend_tails, lpm_extend_tail_array, lpm_init, lpm_init_sgs_tke, lpm_pack_arrays, lpm_read_restart_file, lpm_release_set, lpm_set_attributes, lpm_sort_arrays, lpm_write_exchange_statistics, lpm_write_restart_file, user_lpm_advec, user_lpm_init, user_lpm_set_attributes

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