Home

Context Navigation

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

Last change on this file since 851 was 851, checked in by raasch, 12 years ago
Bugfix: resetting of particle_mask and tail mask moved from routine lpm_exchange_horiz to routine lpm (end of sub-timestep loop)
Property svn:keywords set to `Id`
File size: 35.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |