Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |