Home

Context Navigation

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

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |