Home

Context Navigation

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

Last change on this file since 1318 was 1318, checked in by raasch, 10 years ago
former files/routines cpu_log and cpu_statistics combined to one module, which also includes the former data module cpulog from the modules-file, module interfaces removed
Property svn:keywords set to `Id`
File size: 36.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |