Home

Context Navigation

exchange_horiz.f90 @ 4429

Last change on this file since 4429 was 4429, checked in by raasch, 4 years ago
serial (non-MPI) test case added, several bugfixes for the serial mode
Property svn:keywords set to `Id`
File size: 13.6 KB

Rev	Line
[1682]	1	!> @file exchange_horiz.f90
[1320]	2	!------------------------------------------------------------------------------!
[2696]	3	! This file is part of the PALM model system.
[1036]	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1036]	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	!
[4360]	17	! Copyright 1997-2020 Leibniz Universitaet Hannover
[1320]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
[1678]	22	!
[2119]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: exchange_horiz.f90 4429 2020-02-27 15:24:30Z raasch $
[4429]	27	! bugfix: cpp-directives added for serial mode
	28	!
	29	! 4360 2020-01-07 11:25:50Z suehring
[4182]	30	! Corrected "Former revisions" section
	31	!
	32	! 3761 2019-02-25 15:31:42Z raasch
[3761]	33	! OpenACC directives re-formatted
	34	!
	35	! 3657 2019-01-07 20:14:18Z knoop
[3634]	36	! OpenACC port for SPEC
[1321]	37	!
[4182]	38	! Revision 1.1 1997/07/24 11:13:29 raasch
	39	! Initial revision
	40	!
	41	!
[1]	42	! Description:
	43	! ------------
[1682]	44	!> Exchange of lateral boundary values (parallel computers) and cyclic
	45	!> lateral boundary conditions, respectively.
[1]	46	!------------------------------------------------------------------------------!
[1682]	47	SUBROUTINE exchange_horiz( ar, nbgp_local)
	48
[1]	49
[1320]	50	USE control_parameters, &
[4429]	51	ONLY: bc_lr_cyc, bc_ns_cyc
	52
	53	#if defined( __parallel )
	54	USE control_parameters, &
	55	ONLY: grid_level, mg_switch_to_pe0, synchronous_exchange
	56	#endif
[1320]	57
	58	USE cpulog, &
	59	ONLY: cpu_log, log_point_s
	60
	61	USE indices, &
	62	ONLY: nxl, nxr, nyn, nys, nzb, nzt
	63
	64	USE kinds
	65
[1]	66	USE pegrid
	67
	68	IMPLICIT NONE
	69
[841]	70
[3761]	71	#if defined( _OPENACC )
[3634]	72	INTEGER(iwp) :: i !<
	73	#endif
[3761]	74
[1682]	75	INTEGER(iwp) :: nbgp_local !<
[1320]	76
	77	REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
[1682]	78	nxl-nbgp_local:nxr+nbgp_local) :: ar !<
[1320]	79
[841]	80
[1]	81	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
	82
[3761]	83	#if defined( _OPENACC )
[3657]	84	!$ACC UPDATE IF_PRESENT ASYNC(1) &
[3634]	85	!$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
	86	!$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
[3657]	87
	88	!
	89	!-- Wait for first UPDATE to complete before starting the others.
	90	!$ACC WAIT(1) ASYNC(2)
	91	! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
	92	! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
	93	DO i = nxl+nbgp_local, nxr-nbgp_local
	94	!$ACC UPDATE IF_PRESENT ASYNC(2) &
[3634]	95	!$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
	96	!$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
	97	ENDDO
[3657]	98	! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
	99	! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
	100
	101	!
	102	!-- Wait for first UPDATE to complete before starting MPI.
	103	!$ACC WAIT(1)
[3634]	104	#endif
	105
[1]	106	#if defined( __parallel )
	107
	108	!
[1128]	109	!-- Exchange in x-direction of lateral boundaries
[1]	110	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
	111	!
	112	!-- One-dimensional decomposition along y, boundary values can be exchanged
	113	!-- within the PE memory
[707]	114	IF ( bc_lr_cyc ) THEN
[667]	115	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	116	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
[1]	117	ENDIF
	118
	119	ELSE
[75]	120
[683]	121	IF ( synchronous_exchange ) THEN
[1]	122	!
[683]	123	!-- Send left boundary, receive right one (synchronous)
	124	CALL MPI_SENDRECV( &
[707]	125	ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), pleft, 0, &
	126	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), pright, 0, &
	127	comm2d, status, ierr )
[1]	128	!
[683]	129	!-- Send right boundary, receive left one (synchronous)
[1320]	130	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
	131	type_yz(grid_level), pright, 1, &
	132	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	133	type_yz(grid_level), pleft, 1, &
[707]	134	comm2d, status, ierr )
[667]	135
[683]	136	ELSE
[667]	137
[683]	138	!
[2298]	139	!-- Asynchroneous exchange
[1128]	140	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
	141
[2298]	142	req(1:4) = 0
	143	req_count = 0
[683]	144	!
[1128]	145	!-- Send left boundary, receive right one (asynchronous)
	146	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), &
	147	pleft, req_count, comm2d, req(req_count+1), ierr )
	148	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), &
	149	pright, req_count, comm2d, req(req_count+2), ierr )
	150	!
	151	!-- Send right boundary, receive left one (asynchronous)
[1320]	152	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
	153	type_yz(grid_level), pright, req_count+1, comm2d, &
[1128]	154	req(req_count+3), ierr )
[1320]	155	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	156	type_yz(grid_level), pleft, req_count+1, comm2d, &
[1128]	157	req(req_count+4), ierr )
[667]	158
[2298]	159	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[75]	160
[1128]	161	ENDIF
	162
[683]	163	ENDIF
	164
[1]	165	ENDIF
	166
[3657]	167	!$ACC UPDATE IF_PRESENT ASYNC(1) &
	168	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
	169	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
[1]	170
[3657]	171	!
	172	!-- Wait for UPDATES above to complete before starting MPI.
	173	!$ACC WAIT(2)
	174
[1]	175	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
	176	!
	177	!-- One-dimensional decomposition along x, boundary values can be exchanged
	178	!-- within the PE memory
[707]	179	IF ( bc_ns_cyc ) THEN
[667]	180	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	181	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
[1]	182	ENDIF
	183
	184	ELSE
	185
[683]	186	IF ( synchronous_exchange ) THEN
[1]	187	!
[683]	188	!-- Send front boundary, receive rear one (synchronous)
	189	CALL MPI_SENDRECV( &
[707]	190	ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), psouth, 0, &
	191	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), pnorth, 0, &
	192	comm2d, status, ierr )
[683]	193	!
	194	!-- Send rear boundary, receive front one (synchronous)
[1320]	195	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	196	type_xz(grid_level), pnorth, 1, &
	197	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	198	type_xz(grid_level), psouth, 1, &
[707]	199	comm2d, status, ierr )
[667]	200
[683]	201	ELSE
	202
[1]	203	!
[2298]	204	!-- Asynchroneous exchange
[1569]	205	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
[1128]	206
[2298]	207	req(1:4) = 0
	208	req_count = 0
[1128]	209
[683]	210	!
[1128]	211	!-- Send front boundary, receive rear one (asynchronous)
	212	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), &
	213	psouth, req_count, comm2d, req(req_count+1), ierr )
	214	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), &
	215	pnorth, req_count, comm2d, req(req_count+2), ierr )
	216	!
	217	!-- Send rear boundary, receive front one (asynchronous)
[1320]	218	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	219	type_xz(grid_level), pnorth, req_count+1, comm2d, &
[1128]	220	req(req_count+3), ierr )
[1320]	221	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	222	type_xz(grid_level), psouth, req_count+1, comm2d, &
[1128]	223	req(req_count+4), ierr )
[75]	224
[2298]	225	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[683]	226
[1128]	227	ENDIF
	228
[683]	229	ENDIF
	230
[1]	231	ENDIF
	232
	233	#else
	234
	235	!
[1113]	236	!-- Lateral boundary conditions in the non-parallel case.
	237	!-- Case dependent, because in GPU mode still not all arrays are on device. This
	238	!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
	239	!-- with array syntax, explicit loops are used.
[3241]	240	IF ( bc_lr_cyc ) THEN
[2118]	241	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	242	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
[1]	243	ENDIF
	244
[3657]	245	!$ACC UPDATE IF_PRESENT ASYNC(1) &
	246	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
	247	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
	248
	249	!
	250	!-- Wait for UPDATES above to complete before starting MPI.
	251	!$ACC WAIT(2)
	252
[3241]	253	IF ( bc_ns_cyc ) THEN
[2118]	254	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	255	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
[1]	256	ENDIF
	257
	258	#endif
[3634]	259
[3761]	260	#if defined( _OPENACC )
[3634]	261	DO i = nxl-nbgp_local, nxr+nbgp_local
[3657]	262	!$ACC UPDATE IF_PRESENT ASYNC(2) &
[3634]	263	!$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
	264	!$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
	265	ENDDO
[3657]	266
	267	!
	268	!-- Wait for all UPDATEs to finish.
	269	!$ACC WAIT
[3634]	270	#endif
	271
[1]	272	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
	273
	274	END SUBROUTINE exchange_horiz
[1677]	275
	276
[1682]	277	!------------------------------------------------------------------------------!
	278	! Description:
	279	! ------------
	280	!> @todo Missing subroutine description.
	281	!------------------------------------------------------------------------------!
[4429]	282	SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
[1677]	283
[4429]	284
[1677]	285	USE control_parameters, &
[4429]	286	ONLY: bc_lr_cyc, bc_ns_cyc
	287
	288	#if defined( __parallel )
	289	USE control_parameters, &
	290	ONLY: grid_level
	291	#endif
[1677]	292
	293	USE indices, &
[3241]	294	ONLY: nzb
[1677]	295
	296	USE kinds
	297
	298	USE pegrid
	299
	300	IMPLICIT NONE
	301
[2696]	302	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
	303	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
	304	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
	305	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
	306	INTEGER(iwp) :: nzt_l !< local index bound at current grid level, top
[1682]	307	INTEGER(iwp) :: nbgp_local !< number of ghost points
[1677]	308
[2696]	309	INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local, &
	310	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
[1677]	311
	312
	313	#if defined( __parallel )
	314	IF ( pdims(1) == 1 ) THEN
	315	!
	316	!-- One-dimensional decomposition along y, boundary values can be exchanged
	317	!-- within the PE memory
	318	IF ( bc_lr_cyc ) THEN
[2696]	319	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
	320	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
[1677]	321	ENDIF
	322	ELSE
	323	!
	324	!-- Send left boundary, receive right one (synchronous)
[2696]	325	CALL MPI_SENDRECV( &
	326	ar(nzb,nys_l-nbgp_local,nxl_l), 1, type_yz_int(grid_level), pleft, 0,&
	327	ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
[1677]	328	comm2d, status, ierr )
	329	!
	330	!-- Send right boundary, receive left one (synchronous)
[2696]	331	CALL MPI_SENDRECV( &
	332	ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
	333	pright, 1, &
	334	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, type_yz_int(grid_level),&
	335	pleft, 1, &
[1677]	336	comm2d, status, ierr )
	337	ENDIF
	338
	339
	340	IF ( pdims(2) == 1 ) THEN
	341	!
	342	!-- One-dimensional decomposition along x, boundary values can be exchanged
	343	!-- within the PE memory
	344	IF ( bc_ns_cyc ) THEN
[2696]	345	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
	346	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
[1677]	347	ENDIF
	348
	349	ELSE
	350
	351	!
	352	!-- Send front boundary, receive rear one (synchronous)
[2696]	353	CALL MPI_SENDRECV( &
	354	ar(nzb,nys_l,nxl_l-nbgp_local), 1, type_xz_int(grid_level), psouth, 0,&
	355	ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
[1677]	356	comm2d, status, ierr )
	357	!
	358	!-- Send rear boundary, receive front one (synchronous)
[2696]	359	CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1, &
	360	type_xz_int(grid_level), pnorth, 1, &
	361	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	362	type_xz_int(grid_level), psouth, 1, &
[1677]	363	comm2d, status, ierr )
	364
	365	ENDIF
	366
	367	#else
	368
[3241]	369	IF ( bc_lr_cyc ) THEN
[2696]	370	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
	371	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
[1677]	372	ENDIF
	373
[3241]	374	IF ( bc_ns_cyc ) THEN
[2696]	375	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
	376	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
[1677]	377	ENDIF
	378
	379	#endif
	380
	381
[1933]	382	END SUBROUTINE exchange_horiz_int

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

Context Navigation

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

Download in other formats: