Home

Context Navigation

source: palm/trunk/SOURCE/exchange_horiz.f90 @ 1989

Last change on this file since 1989 was 1933, checked in by hellstea, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 13.8 KB

Rev	Line
[1682]	1	!> @file exchange_horiz.f90
[1320]	2	!------------------------------------------------------------------------------!
[1036]	3	! This file is part of PALM.
	4	!
	5	! PALM is free software: you can redistribute it and/or modify it under the terms
	6	! of the GNU General Public License as published by the Free Software Foundation,
	7	! either version 3 of the License, or (at your option) any later version.
	8	!
	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	10	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	11	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	12	!
	13	! You should have received a copy of the GNU General Public License along with
	14	! PALM. If not, see <http://www.gnu.org/licenses/>.
	15	!
[1818]	16	! Copyright 1997-2016 Leibniz Universitaet Hannover
[1320]	17	!------------------------------------------------------------------------------!
[1036]	18	!
[484]	19	! Current revisions:
[1]	20	! -----------------
[1678]	21	!
[1805]	22	!
[1321]	23	! Former revisions:
	24	! -----------------
	25	! $Id: exchange_horiz.f90 1933 2016-06-13 07:12:51Z gronemeier $
	26	!
[1805]	27	! 1804 2016-04-05 16:30:18Z maronga
	28	! Removed code for parameter file check (__check)
	29	!
[1683]	30	! 1682 2015-10-07 23:56:08Z knoop
	31	! Code annotations made doxygen readable
	32	!
[1678]	33	! 1677 2015-10-02 13:25:23Z boeske
	34	! Added new routine for exchange of three-dimensional integer arrays
	35	!
[1570]	36	! 1569 2015-03-12 07:54:38Z raasch
	37	! bugfix in background communication part
	38	!
[1349]	39	! 1348 2014-03-27 18:01:03Z raasch
[1569]	40	! bugfix: on_device added to ONLY-list
[1349]	41	!
[1345]	42	! 1344 2014-03-26 17:33:09Z kanani
	43	! Added missing parameters to ONLY-attribute
	44	!
[1321]	45	! 1320 2014-03-20 08:40:49Z raasch
[1320]	46	! ONLY-attribute added to USE-statements,
	47	! kind-parameters added to all INTEGER and REAL declaration statements,
	48	! kinds are defined in new module kinds,
	49	! revision history before 2012 removed,
	50	! comment fields (!:) to be used for variable explanations added to
	51	! all variable declaration statements
[668]	52	!
[1258]	53	! 1257 2013-11-08 15:18:40Z raasch
	54	! openacc loop and loop vector clauses removed
	55	!
[1132]	56	! 1128 2013-04-12 06:19:32Z raasch
	57	! modifications for asynchronous transfer,
	58	! local variables req, wait_stat are global now, and have been moved to module
	59	! pegrid
	60	!
[1114]	61	! 1113 2013-03-10 02:48:14Z raasch
	62	! GPU-porting for single-core (1PE) mode
	63	!
[1037]	64	! 1036 2012-10-22 13:43:42Z raasch
	65	! code put under GPL (PALM 3.9)
	66	!
[842]	67	! 841 2012-02-28 12:29:49Z maronga
	68	! Excluded routine from compilation of namelist_file_check
	69	!
[1]	70	! Revision 1.1 1997/07/24 11:13:29 raasch
	71	! Initial revision
	72	!
	73	!
	74	! Description:
	75	! ------------
[1682]	76	!> Exchange of lateral boundary values (parallel computers) and cyclic
	77	!> lateral boundary conditions, respectively.
[1]	78	!------------------------------------------------------------------------------!
[1682]	79	SUBROUTINE exchange_horiz( ar, nbgp_local)
	80
[1]	81
[1320]	82	USE control_parameters, &
[1344]	83	ONLY: bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, grid_level, &
[1348]	84	mg_switch_to_pe0, on_device, synchronous_exchange
[1320]	85
	86	USE cpulog, &
	87	ONLY: cpu_log, log_point_s
	88
	89	USE indices, &
	90	ONLY: nxl, nxr, nyn, nys, nzb, nzt
	91
	92	USE kinds
	93
[1]	94	USE pegrid
	95
	96	IMPLICIT NONE
	97
[841]	98
[1682]	99	INTEGER(iwp) :: i !<
	100	INTEGER(iwp) :: j !<
	101	INTEGER(iwp) :: k !<
	102	INTEGER(iwp) :: nbgp_local !<
[1320]	103
	104	REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
[1682]	105	nxl-nbgp_local:nxr+nbgp_local) :: ar !<
[1320]	106
[841]	107
[1]	108	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
	109
	110	#if defined( __parallel )
	111
	112	!
[1128]	113	!-- Exchange in x-direction of lateral boundaries
[1]	114	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
	115	!
	116	!-- One-dimensional decomposition along y, boundary values can be exchanged
	117	!-- within the PE memory
[707]	118	IF ( bc_lr_cyc ) THEN
[667]	119	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	120	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
[1]	121	ENDIF
	122
	123	ELSE
[75]	124
[683]	125	IF ( synchronous_exchange ) THEN
[1]	126	!
[683]	127	!-- Send left boundary, receive right one (synchronous)
	128	CALL MPI_SENDRECV( &
[707]	129	ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), pleft, 0, &
	130	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), pright, 0, &
	131	comm2d, status, ierr )
[1]	132	!
[683]	133	!-- Send right boundary, receive left one (synchronous)
[1320]	134	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
	135	type_yz(grid_level), pright, 1, &
	136	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	137	type_yz(grid_level), pleft, 1, &
[707]	138	comm2d, status, ierr )
[667]	139
[683]	140	ELSE
[667]	141
[683]	142	!
[1128]	143	!-- In case of background communication switched on, exchange is done
	144	!-- either along x or along y
	145	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
	146
	147	IF ( .NOT. sendrecv_in_background ) THEN
	148	req(1:4) = 0
	149	req_count = 0
	150	ENDIF
[683]	151	!
[1128]	152	!-- Send left boundary, receive right one (asynchronous)
	153	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), &
	154	pleft, req_count, comm2d, req(req_count+1), ierr )
	155	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), &
	156	pright, req_count, comm2d, req(req_count+2), ierr )
	157	!
	158	!-- Send right boundary, receive left one (asynchronous)
[1320]	159	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
	160	type_yz(grid_level), pright, req_count+1, comm2d, &
[1128]	161	req(req_count+3), ierr )
[1320]	162	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	163	type_yz(grid_level), pleft, req_count+1, comm2d, &
[1128]	164	req(req_count+4), ierr )
[667]	165
[1128]	166	IF ( .NOT. sendrecv_in_background ) THEN
	167	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
	168	ELSE
	169	req_count = req_count + 4
	170	ENDIF
[75]	171
[1128]	172	ENDIF
	173
[683]	174	ENDIF
	175
[1]	176	ENDIF
	177
	178
	179	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
	180	!
	181	!-- One-dimensional decomposition along x, boundary values can be exchanged
	182	!-- within the PE memory
[707]	183	IF ( bc_ns_cyc ) THEN
[667]	184	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	185	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
[1]	186	ENDIF
	187
	188	ELSE
	189
[683]	190	IF ( synchronous_exchange ) THEN
[1]	191	!
[683]	192	!-- Send front boundary, receive rear one (synchronous)
	193	CALL MPI_SENDRECV( &
[707]	194	ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), psouth, 0, &
	195	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), pnorth, 0, &
	196	comm2d, status, ierr )
[683]	197	!
	198	!-- Send rear boundary, receive front one (synchronous)
[1320]	199	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	200	type_xz(grid_level), pnorth, 1, &
	201	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	202	type_xz(grid_level), psouth, 1, &
[707]	203	comm2d, status, ierr )
[667]	204
[683]	205	ELSE
	206
[1]	207	!
[1128]	208	!-- In case of background communication switched on, exchange is done
	209	!-- either along x or along y
[1569]	210	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
[1128]	211
	212	IF ( .NOT. sendrecv_in_background ) THEN
	213	req(1:4) = 0
	214	req_count = 0
	215	ENDIF
	216
[683]	217	!
[1128]	218	!-- Send front boundary, receive rear one (asynchronous)
	219	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), &
	220	psouth, req_count, comm2d, req(req_count+1), ierr )
	221	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), &
	222	pnorth, req_count, comm2d, req(req_count+2), ierr )
	223	!
	224	!-- Send rear boundary, receive front one (asynchronous)
[1320]	225	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	226	type_xz(grid_level), pnorth, req_count+1, comm2d, &
[1128]	227	req(req_count+3), ierr )
[1320]	228	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	229	type_xz(grid_level), psouth, req_count+1, comm2d, &
[1128]	230	req(req_count+4), ierr )
[75]	231
[1128]	232	IF ( .NOT. sendrecv_in_background ) THEN
	233	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
	234	ELSE
	235	req_count = req_count + 4
	236	ENDIF
[683]	237
[1128]	238	ENDIF
	239
[683]	240	ENDIF
	241
[1]	242	ENDIF
	243
	244	#else
	245
	246	!
[1113]	247	!-- Lateral boundary conditions in the non-parallel case.
	248	!-- Case dependent, because in GPU mode still not all arrays are on device. This
	249	!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
	250	!-- with array syntax, explicit loops are used.
[1]	251	IF ( bc_lr == 'cyclic' ) THEN
[1113]	252	IF ( on_device ) THEN
	253	!$acc kernels present( ar )
	254	!$acc loop independent
	255	DO i = 0, nbgp_local-1
	256	DO j = nys-nbgp_local, nyn+nbgp_local
	257	DO k = nzb, nzt+1
	258	ar(k,j,nxl-nbgp_local+i) = ar(k,j,nxr-nbgp_local+1+i)
	259	ar(k,j,nxr+1+i) = ar(k,j,nxl+i)
	260	ENDDO
	261	ENDDO
	262	ENDDO
	263	!$acc end kernels
	264	ELSE
	265	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	266	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
	267	ENDIF
[1]	268	ENDIF
	269
	270	IF ( bc_ns == 'cyclic' ) THEN
[1113]	271	IF ( on_device ) THEN
	272	!$acc kernels present( ar )
	273	DO i = nxl-nbgp_local, nxr+nbgp_local
	274	!$acc loop independent
	275	DO j = 0, nbgp_local-1
[1257]	276	!$acc loop independent
[1113]	277	DO k = nzb, nzt+1
	278	ar(k,nys-nbgp_local+j,i) = ar(k,nyn-nbgp_local+1+j,i)
[1933]	279	ar(k,nyn+1+j,i) = ar(k,nys+j,i)
[1113]	280	ENDDO
	281	ENDDO
	282	ENDDO
	283	!$acc end kernels
	284	ELSE
	285	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	286	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
	287	ENDIF
[1]	288	ENDIF
	289
	290	#endif
	291	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
	292
	293	END SUBROUTINE exchange_horiz
[1677]	294
	295
[1682]	296	!------------------------------------------------------------------------------!
	297	! Description:
	298	! ------------
	299	!> @todo Missing subroutine description.
	300	!------------------------------------------------------------------------------!
[1677]	301	SUBROUTINE exchange_horiz_int( ar, nbgp_local)
	302
	303	USE control_parameters, &
	304	ONLY: bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc
	305
	306	USE indices, &
	307	ONLY: nxl, nxr, nyn, nys, nzb, nzt
	308
	309	USE kinds
	310
	311	USE pegrid
	312
	313	IMPLICIT NONE
	314
	315
[1682]	316	INTEGER(iwp) :: nbgp_local !< number of ghost points
[1677]	317
	318	INTEGER(iwp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
[1682]	319	nxl-nbgp_local:nxr+nbgp_local) :: ar !< treated array
[1677]	320
	321
	322	#if defined( __parallel )
	323	IF ( pdims(1) == 1 ) THEN
	324	!
	325	!-- One-dimensional decomposition along y, boundary values can be exchanged
	326	!-- within the PE memory
	327	IF ( bc_lr_cyc ) THEN
	328	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	329	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
	330	ENDIF
	331	ELSE
	332	!
	333	!-- Send left boundary, receive right one (synchronous)
	334	CALL MPI_SENDRECV( &
	335	ar(nzb,nys-nbgp_local,nxl), 1, type_yz_int, pleft, 0, &
	336	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz_int, pright, 0, &
	337	comm2d, status, ierr )
	338	!
	339	!-- Send right boundary, receive left one (synchronous)
	340	CALL MPI_SENDRECV( &
	341	ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, type_yz_int, pright, 1, &
	342	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, type_yz_int, pleft, 1, &
	343	comm2d, status, ierr )
	344	ENDIF
	345
	346
	347	IF ( pdims(2) == 1 ) THEN
	348	!
	349	!-- One-dimensional decomposition along x, boundary values can be exchanged
	350	!-- within the PE memory
	351	IF ( bc_ns_cyc ) THEN
	352	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	353	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
	354	ENDIF
	355
	356	ELSE
	357
	358	!
	359	!-- Send front boundary, receive rear one (synchronous)
	360	CALL MPI_SENDRECV( &
	361	ar(nzb,nys,nxl-nbgp_local), 1, type_xz_int, psouth, 0, &
	362	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz_int, pnorth, 0, &
	363	comm2d, status, ierr )
	364	!
	365	!-- Send rear boundary, receive front one (synchronous)
	366	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	367	type_xz_int, pnorth, 1, &
	368	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	369	type_xz_int, psouth, 1, &
	370	comm2d, status, ierr )
	371
	372	ENDIF
	373
	374	#else
	375
	376	IF ( bc_lr == 'cyclic' ) THEN
	377	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	378	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
	379	ENDIF
	380
	381	IF ( bc_ns == 'cyclic' ) THEN
	382	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	383	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
	384	ENDIF
	385
	386	#endif
	387
	388
[1933]	389	END SUBROUTINE exchange_horiz_int

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |