Home

Context Navigation

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

Last change on this file since 850 was 850, checked in by raasch, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 36.0 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |