Home

Context Navigation

lpm_exchange_horiz.f90 @ 849

Last change on this file since 849 was 849, checked in by raasch, 12 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	i = 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.

Context Navigation

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

Download in other formats: