Home

Context Navigation

source: palm/trunk/SOURCE/exchange_horiz_mod.f90 @ 4468

Last change on this file since 4468 was 4461, checked in by raasch, 5 years ago
extensions to allow usage of alternative communicators in exchange_horiz
Property svn:keywords set to `Id`
File size: 30.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_mod.f90 4461 2020-03-12 16:51:59Z suehring $
[4461]	27	! optional communicator added to exchange_horiz
	28	!
	29	! 4457 2020-03-11 14:20:43Z raasch
[4457]	30	! routine has been modularized, file exchange_horiz_2d has been merged
	31	!
	32	! 4429 2020-02-27 15:24:30Z raasch
[4429]	33	! bugfix: cpp-directives added for serial mode
	34	!
	35	! 4360 2020-01-07 11:25:50Z suehring
[4182]	36	! Corrected "Former revisions" section
	37	!
	38	! 3761 2019-02-25 15:31:42Z raasch
[3761]	39	! OpenACC directives re-formatted
	40	!
	41	! 3657 2019-01-07 20:14:18Z knoop
[3634]	42	! OpenACC port for SPEC
[1321]	43	!
[4182]	44	! Revision 1.1 1997/07/24 11:13:29 raasch
	45	! Initial revision
	46	!
	47	!
[1]	48	! Description:
	49	! ------------
[4461]	50	!> Exchange of ghost point layers for subdomains (in parallel mode) and setting
	51	!> of cyclic lateral boundary conditions for the total domain .
[1]	52	!------------------------------------------------------------------------------!
[4457]	53	MODULE exchange_horiz_mod
	54
	55	USE kinds
	56
	57	USE pegrid
	58
	59	IMPLICIT NONE
	60
	61	PRIVATE
	62	PUBLIC exchange_horiz, exchange_horiz_int, exchange_horiz_2d, exchange_horiz_2d_byte, &
	63	exchange_horiz_2d_int
	64
	65	INTERFACE exchange_horiz
	66	MODULE PROCEDURE exchange_horiz
	67	END INTERFACE exchange_horiz
	68
	69	INTERFACE exchange_horiz_int
	70	MODULE PROCEDURE exchange_horiz_int
	71	END INTERFACE exchange_horiz_int
	72
	73	INTERFACE exchange_horiz_2d
	74	MODULE PROCEDURE exchange_horiz_2d
	75	END INTERFACE exchange_horiz_2d
	76
	77	INTERFACE exchange_horiz_2d_byte
	78	MODULE PROCEDURE exchange_horiz_2d_byte
	79	END INTERFACE exchange_horiz_2d_byte
	80
	81	INTERFACE exchange_horiz_2d_int
	82	MODULE PROCEDURE exchange_horiz_2d_int
	83	END INTERFACE exchange_horiz_2d_int
	84
	85
	86	CONTAINS
	87
	88
[4461]	89	!------------------------------------------------------------------------------!
	90	! Description:
	91	! ------------
	92	!> Exchange of ghost point layers for subdomains (in parallel mode) and setting
	93	!> of cyclic lateral boundary conditions for the total domain.
	94	!> This routine is for REAL 3d-arrays.
	95	!------------------------------------------------------------------------------!
	96	SUBROUTINE exchange_horiz( ar, nbgp_local, alternative_communicator)
[1]	97
[1320]	98	USE control_parameters, &
[4429]	99	ONLY: bc_lr_cyc, bc_ns_cyc
	100
	101	#if defined( __parallel )
	102	USE control_parameters, &
	103	ONLY: grid_level, mg_switch_to_pe0, synchronous_exchange
	104	#endif
[1320]	105
	106	USE cpulog, &
	107	ONLY: cpu_log, log_point_s
	108
	109	USE indices, &
	110	ONLY: nxl, nxr, nyn, nys, nzb, nzt
	111
[1]	112
[3761]	113	#if defined( _OPENACC )
[3634]	114	INTEGER(iwp) :: i !<
	115	#endif
[3761]	116
[4461]	117	INTEGER(iwp), OPTIONAL :: alternative_communicator !< alternative MPI communicator to be used
	118	INTEGER(iwp) :: communicator !< communicator that is used as argument in MPI calls
	119	INTEGER(iwp) :: left_pe !< id of left pe that is used as argument in MPI calls
	120	INTEGER(iwp) :: nbgp_local !< number of ghost point layers
	121	INTEGER(iwp) :: north_pe !< id of north pe that is used as argument in MPI calls
	122	INTEGER(iwp) :: right_pe !< id of right pe that is used as argument in MPI calls
	123	INTEGER(iwp) :: south_pe !< id of south pe that is used as argument in MPI calls
[1320]	124
	125	REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
[4461]	126	nxl-nbgp_local:nxr+nbgp_local) :: ar !< 3d-array for which exchange is done
[1320]	127
[841]	128
[1]	129	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
	130
[3761]	131	#if defined( _OPENACC )
[3657]	132	!$ACC UPDATE IF_PRESENT ASYNC(1) &
[3634]	133	!$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
	134	!$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
[3657]	135
	136	!
	137	!-- Wait for first UPDATE to complete before starting the others.
	138	!$ACC WAIT(1) ASYNC(2)
	139	! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
	140	! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
	141	DO i = nxl+nbgp_local, nxr-nbgp_local
	142	!$ACC UPDATE IF_PRESENT ASYNC(2) &
[3634]	143	!$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
	144	!$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
	145	ENDDO
[3657]	146	! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
	147	! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
	148
	149	!
	150	!-- Wait for first UPDATE to complete before starting MPI.
	151	!$ACC WAIT(1)
[3634]	152	#endif
	153
[4461]	154	!
	155	!-- Set the communicator to be used
	156	IF ( PRESENT( alternative_communicator ) ) THEN
	157	!
	158	!-- Alternative communicator is to be used
	159	communicator = communicator_configurations(alternative_communicator)%mpi_communicator
	160	left_pe = communicator_configurations(alternative_communicator)%pleft
	161	right_pe = communicator_configurations(alternative_communicator)%pright
	162	south_pe = communicator_configurations(alternative_communicator)%psouth
	163	north_pe = communicator_configurations(alternative_communicator)%pnorth
	164
	165	ELSE
	166	!
	167	!-- Main communicator is to be used
	168	communicator = comm2d
	169	left_pe = pleft
	170	right_pe = pright
	171	south_pe = psouth
	172	north_pe = pnorth
	173
	174	ENDIF
	175
[1]	176	#if defined( __parallel )
	177
	178	!
[1128]	179	!-- Exchange in x-direction of lateral boundaries
[1]	180	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
	181	!
	182	!-- One-dimensional decomposition along y, boundary values can be exchanged
	183	!-- within the PE memory
[707]	184	IF ( bc_lr_cyc ) THEN
[667]	185	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	186	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
[1]	187	ENDIF
	188
	189	ELSE
[75]	190
[683]	191	IF ( synchronous_exchange ) THEN
[1]	192	!
[683]	193	!-- Send left boundary, receive right one (synchronous)
[4461]	194	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), left_pe, 0, &
	195	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe, 0, &
	196	communicator, status, ierr )
[1]	197	!
[683]	198	!-- Send right boundary, receive left one (synchronous)
[4461]	199	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
	200	type_yz(grid_level), right_pe, 1, &
	201	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	202	type_yz(grid_level), left_pe, 1, &
	203	communicator, status, ierr )
[667]	204
[683]	205	ELSE
[667]	206
[683]	207	!
[2298]	208	!-- Asynchroneous exchange
[1128]	209	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
	210
[2298]	211	req(1:4) = 0
	212	req_count = 0
[683]	213	!
[1128]	214	!-- Send left boundary, receive right one (asynchronous)
[4461]	215	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), left_pe, &
	216	req_count, communicator, req(req_count+1), ierr )
	217	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe, &
	218	req_count, communicator, req(req_count+2), ierr )
[1128]	219	!
	220	!-- Send right boundary, receive left one (asynchronous)
[4461]	221	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, type_yz(grid_level), &
	222	right_pe, req_count+1, communicator, req(req_count+3), ierr )
	223	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, type_yz(grid_level), &
	224	left_pe, req_count+1, communicator, req(req_count+4), ierr )
[667]	225
[2298]	226	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[75]	227
[1128]	228	ENDIF
	229
[683]	230	ENDIF
	231
[1]	232	ENDIF
	233
[3657]	234	!$ACC UPDATE IF_PRESENT ASYNC(1) &
	235	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
	236	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
[1]	237
[3657]	238	!
	239	!-- Wait for UPDATES above to complete before starting MPI.
	240	!$ACC WAIT(2)
	241
[1]	242	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
	243	!
	244	!-- One-dimensional decomposition along x, boundary values can be exchanged
	245	!-- within the PE memory
[707]	246	IF ( bc_ns_cyc ) THEN
[667]	247	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	248	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
[1]	249	ENDIF
	250
	251	ELSE
	252
[683]	253	IF ( synchronous_exchange ) THEN
[1]	254	!
[683]	255	!-- Send front boundary, receive rear one (synchronous)
[4461]	256	CALL MPI_SENDRECV( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), south_pe, 0, &
	257	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe, 0, &
	258	communicator, status, ierr )
[683]	259	!
	260	!-- Send rear boundary, receive front one (synchronous)
[4461]	261	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
	262	type_xz(grid_level), north_pe, 1, &
	263	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
	264	type_xz(grid_level), south_pe, 1, &
	265	communicator, status, ierr )
[667]	266
[683]	267	ELSE
	268
[1]	269	!
[2298]	270	!-- Asynchroneous exchange
[1569]	271	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
[1128]	272
[2298]	273	req(1:4) = 0
	274	req_count = 0
[1128]	275
[683]	276	!
[1128]	277	!-- Send front boundary, receive rear one (asynchronous)
[4461]	278	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), south_pe, &
	279	req_count, communicator, req(req_count+1), ierr )
	280	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe, &
	281	req_count, communicator, req(req_count+2), ierr )
[1128]	282	!
	283	!-- Send rear boundary, receive front one (asynchronous)
[4461]	284	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, type_xz(grid_level), &
	285	north_pe, req_count+1, communicator, req(req_count+3), ierr )
	286	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, type_xz(grid_level), &
	287	south_pe, req_count+1, communicator, req(req_count+4), ierr )
[75]	288
[2298]	289	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[683]	290
[1128]	291	ENDIF
	292
[683]	293	ENDIF
	294
[1]	295	ENDIF
	296
	297	#else
	298
	299	!
[1113]	300	!-- Lateral boundary conditions in the non-parallel case.
	301	!-- Case dependent, because in GPU mode still not all arrays are on device. This
	302	!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
	303	!-- with array syntax, explicit loops are used.
[3241]	304	IF ( bc_lr_cyc ) THEN
[2118]	305	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
	306	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
[1]	307	ENDIF
	308
[3657]	309	!$ACC UPDATE IF_PRESENT ASYNC(1) &
	310	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
	311	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
	312
	313	!
	314	!-- Wait for UPDATES above to complete before starting MPI.
	315	!$ACC WAIT(2)
	316
[3241]	317	IF ( bc_ns_cyc ) THEN
[2118]	318	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
	319	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
[1]	320	ENDIF
	321
	322	#endif
[3634]	323
[3761]	324	#if defined( _OPENACC )
[3634]	325	DO i = nxl-nbgp_local, nxr+nbgp_local
[3657]	326	!$ACC UPDATE IF_PRESENT ASYNC(2) &
[3634]	327	!$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
	328	!$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
	329	ENDDO
[3657]	330
	331	!
	332	!-- Wait for all UPDATEs to finish.
	333	!$ACC WAIT
[3634]	334	#endif
	335
[1]	336	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
	337
	338	END SUBROUTINE exchange_horiz
[1677]	339
	340
[1682]	341	!------------------------------------------------------------------------------!
	342	! Description:
	343	! ------------
	344	!> @todo Missing subroutine description.
	345	!------------------------------------------------------------------------------!
[4429]	346	SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
[1677]	347
[4429]	348
[1677]	349	USE control_parameters, &
[4429]	350	ONLY: bc_lr_cyc, bc_ns_cyc
	351
	352	#if defined( __parallel )
	353	USE control_parameters, &
	354	ONLY: grid_level
	355	#endif
[1677]	356
	357	USE indices, &
[3241]	358	ONLY: nzb
[1677]	359
[2696]	360	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
	361	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
	362	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
	363	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
	364	INTEGER(iwp) :: nzt_l !< local index bound at current grid level, top
[1682]	365	INTEGER(iwp) :: nbgp_local !< number of ghost points
[1677]	366
[2696]	367	INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local, &
	368	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
[1677]	369
	370
	371	#if defined( __parallel )
	372	IF ( pdims(1) == 1 ) THEN
	373	!
	374	!-- One-dimensional decomposition along y, boundary values can be exchanged
	375	!-- within the PE memory
	376	IF ( bc_lr_cyc ) THEN
[2696]	377	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
	378	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
[1677]	379	ENDIF
	380	ELSE
	381	!
	382	!-- Send left boundary, receive right one (synchronous)
[2696]	383	CALL MPI_SENDRECV( &
	384	ar(nzb,nys_l-nbgp_local,nxl_l), 1, type_yz_int(grid_level), pleft, 0,&
	385	ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
[1677]	386	comm2d, status, ierr )
	387	!
	388	!-- Send right boundary, receive left one (synchronous)
[2696]	389	CALL MPI_SENDRECV( &
	390	ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
	391	pright, 1, &
	392	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, type_yz_int(grid_level),&
	393	pleft, 1, &
[1677]	394	comm2d, status, ierr )
	395	ENDIF
	396
	397
	398	IF ( pdims(2) == 1 ) THEN
	399	!
	400	!-- One-dimensional decomposition along x, boundary values can be exchanged
	401	!-- within the PE memory
	402	IF ( bc_ns_cyc ) THEN
[2696]	403	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
	404	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
[1677]	405	ENDIF
	406
	407	ELSE
	408
	409	!
	410	!-- Send front boundary, receive rear one (synchronous)
[2696]	411	CALL MPI_SENDRECV( &
	412	ar(nzb,nys_l,nxl_l-nbgp_local), 1, type_xz_int(grid_level), psouth, 0,&
	413	ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
[1677]	414	comm2d, status, ierr )
	415	!
	416	!-- Send rear boundary, receive front one (synchronous)
[2696]	417	CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1, &
	418	type_xz_int(grid_level), pnorth, 1, &
	419	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	420	type_xz_int(grid_level), psouth, 1, &
[1677]	421	comm2d, status, ierr )
	422
	423	ENDIF
	424
	425	#else
	426
[3241]	427	IF ( bc_lr_cyc ) THEN
[2696]	428	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
	429	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
[1677]	430	ENDIF
	431
[3241]	432	IF ( bc_ns_cyc ) THEN
[2696]	433	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
	434	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
[1677]	435	ENDIF
	436
	437	#endif
	438
[4457]	439	END SUBROUTINE exchange_horiz_int
[1677]	440
[4457]	441	! Description:
	442	! ------------
	443	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
	444	!> boundary conditions, respectively, for 2D-arrays.
	445	!------------------------------------------------------------------------------!
	446	SUBROUTINE exchange_horiz_2d( ar )
	447
	448	USE control_parameters, &
	449	ONLY : bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, &
	450	bc_dirichlet_s, bc_radiation_l, &
	451	bc_radiation_n, bc_radiation_r, bc_radiation_s
	452
	453	USE cpulog, &
	454	ONLY : cpu_log, log_point_s
	455
	456	USE indices, &
	457	ONLY : nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
	458
	459	#if ! defined( __parallel )
	460	USE control_parameters, &
	461	ONLY: bc_lr_cyc, bc_ns_cyc
	462	#endif
	463
	464
	465	INTEGER(iwp) :: i !<
	466
	467	REAL(wp) :: ar(nysg:nyng,nxlg:nxrg) !<
	468
	469
	470	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
	471
	472	#if defined( __parallel )
	473
	474	!
	475	!-- Exchange of lateral boundary values for parallel computers
	476	IF ( pdims(1) == 1 ) THEN
	477
	478	!
	479	!-- One-dimensional decomposition along y, boundary values can be exchanged
	480	!-- within the PE memory
	481	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
	482	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
	483
	484	ELSE
	485	!
	486	!-- Send left boundary, receive right one
	487
	488	CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft, 0, &
	489	ar(nysg,nxr+1), 1, type_y, pright, 0, &
	490	comm2d, status, ierr )
	491	!
	492	!-- Send right boundary, receive left one
	493	CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright, 1, &
	494	ar(nysg,nxlg), 1, type_y, pleft, 1, &
	495	comm2d, status, ierr )
	496
	497
	498	ENDIF
	499
	500	IF ( pdims(2) == 1 ) THEN
	501	!
	502	!-- One-dimensional decomposition along x, boundary values can be exchanged
	503	!-- within the PE memory
	504	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
	505	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
	506
	507	ELSE
	508	!
	509	!-- Send front boundary, receive rear one
	510
	511	CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0, &
	512	ar(nyn+1,nxlg), 1, type_x, pnorth, 0, &
	513	comm2d, status, ierr )
	514	!
	515	!-- Send rear boundary, receive front one
	516	CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1, &
	517	ar(nysg,nxlg), 1, type_x, psouth, 1, &
	518	comm2d, status, ierr )
	519
	520	ENDIF
	521
	522	#else
	523
	524	!
	525	!-- Lateral boundary conditions in the non-parallel case
	526	IF ( bc_lr_cyc ) THEN
	527	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
	528	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
	529	ENDIF
	530
	531	IF ( bc_ns_cyc ) THEN
	532	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
	533	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
	534	ENDIF
	535
	536	#endif
	537
	538	!
	539	!-- Neumann-conditions at inflow/outflow/nested boundaries
	540	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
	541	DO i = nbgp, 1, -1
	542	ar(:,nxl-i) = ar(:,nxl)
	543	ENDDO
	544	ENDIF
	545	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
	546	DO i = 1, nbgp
	547	ar(:,nxr+i) = ar(:,nxr)
	548	ENDDO
	549	ENDIF
	550	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
	551	DO i = nbgp, 1, -1
	552	ar(nys-i,:) = ar(nys,:)
	553	ENDDO
	554	ENDIF
	555	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
	556	DO i = 1, nbgp
	557	ar(nyn+i,:) = ar(nyn,:)
	558	ENDDO
	559	ENDIF
	560
	561	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
	562
	563	END SUBROUTINE exchange_horiz_2d
	564
	565
	566	!------------------------------------------------------------------------------!
	567	! Description:
	568	! ------------
	569	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
	570	!> boundary conditions, respectively, for 2D 8-bit integer arrays.
	571	!------------------------------------------------------------------------------!
	572	SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
	573
	574
	575	USE control_parameters, &
	576	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
	577	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
	578	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
	579
	580	USE cpulog, &
	581	ONLY: cpu_log, log_point_s
	582
	583	#if ! defined( __parallel )
	584	USE control_parameters, &
	585	ONLY: bc_lr_cyc, bc_ns_cyc
	586	#endif
	587
	588	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
	589	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
	590	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
	591	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
	592	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
	593	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
	594
	595	INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
	596	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
	597
	598	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
	599
	600	#if defined( __parallel )
	601
	602	!
	603	!-- Exchange of lateral boundary values for parallel computers
	604	IF ( pdims(1) == 1 ) THEN
	605
	606	!
	607	!-- One-dimensional decomposition along y, boundary values can be exchanged
	608	!-- within the PE memory
	609	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
	610	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
	611
	612	ELSE
	613	!
	614	!-- Send left boundary, receive right one
	615	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
	616	type_y_byte, pleft, 0, &
	617	ar(nys_l-nbgp_local,nxr_l+1), 1, &
	618	type_y_byte, pright, 0, &
	619	comm2d, status, ierr )
	620	!
	621	!-- Send right boundary, receive left one
	622	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
	623	type_y_byte, pright, 1, &
	624	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	625	type_y_byte, pleft, 1, &
	626	comm2d, status, ierr )
	627
	628	ENDIF
	629
	630	IF ( pdims(2) == 1 ) THEN
	631	!
	632	!-- One-dimensional decomposition along x, boundary values can be exchanged
	633	!-- within the PE memory
	634	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
	635	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
	636
	637
	638	ELSE
	639	!
	640	!-- Send front boundary, receive rear one
	641	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
	642	type_x_byte, psouth, 0, &
	643	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
	644	type_x_byte, pnorth, 0, &
	645	comm2d, status, ierr )
	646
	647	!
	648	!-- Send rear boundary, receive front one
	649	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
	650	type_x_byte, pnorth, 1, &
	651	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	652	type_x_byte, psouth, 1, &
	653	comm2d, status, ierr )
	654
	655	ENDIF
	656
	657	#else
	658
	659	!
	660	!-- Lateral boundary conditions in the non-parallel case
	661	IF ( bc_lr_cyc ) THEN
	662	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
	663	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
	664	ENDIF
	665
	666	IF ( bc_ns_cyc ) THEN
	667	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
	668	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
	669	ENDIF
	670
	671	#endif
	672	!
	673	!-- Neumann-conditions at inflow/outflow/nested boundaries
	674	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
	675	DO i = nbgp_local, 1, -1
	676	ar(:,nxl_l-i) = ar(:,nxl_l)
	677	ENDDO
	678	ENDIF
	679	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
	680	DO i = 1, nbgp_local
	681	ar(:,nxr_l+i) = ar(:,nxr_l)
	682	ENDDO
	683	ENDIF
	684	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
	685	DO i = nbgp_local, 1, -1
	686	ar(nys_l-i,:) = ar(nys_l,:)
	687	ENDDO
	688	ENDIF
	689	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
	690	DO i = 1, nbgp_local
	691	ar(nyn_l+i,:) = ar(nyn_l,:)
	692	ENDDO
	693	ENDIF
	694
	695	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
	696
	697	END SUBROUTINE exchange_horiz_2d_byte
	698
	699
	700	!------------------------------------------------------------------------------!
	701	! Description:
	702	! ------------
	703	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
	704	!> boundary conditions, respectively, for 2D 32-bit integer arrays.
	705	!------------------------------------------------------------------------------!
	706	SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
	707
	708
	709	USE control_parameters, &
	710	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
	711	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
	712	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
	713
	714	#if defined( __parallel )
	715	USE control_parameters, &
	716	ONLY: grid_level
	717	#endif
	718
	719	USE cpulog, &
	720	ONLY: cpu_log, log_point_s
	721
	722	#if ! defined( __parallel )
	723	USE control_parameters, &
	724	ONLY: bc_lr_cyc, bc_ns_cyc
	725	#endif
	726
	727	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
	728	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
	729	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
	730	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
	731	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
	732	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
	733
	734	INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
	735	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
	736
	737	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
	738
	739	#if defined( __parallel )
	740
	741	!
	742	!-- Exchange of lateral boundary values for parallel computers
	743	IF ( pdims(1) == 1 ) THEN
	744
	745	!
	746	!-- One-dimensional decomposition along y, boundary values can be exchanged
	747	!-- within the PE memory
	748	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
	749	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
	750
	751	ELSE
	752	!
	753	!-- Send left boundary, receive right one
	754	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
	755	type_y_int(grid_level), pleft, 0, &
	756	ar(nys_l-nbgp_local,nxr_l+1), 1, &
	757	type_y_int(grid_level), pright, 0, &
	758	comm2d, status, ierr )
	759	!
	760	!-- Send right boundary, receive left one
	761	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
	762	type_y_int(grid_level), pright, 1, &
	763	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	764	type_y_int(grid_level), pleft, 1, &
	765	comm2d, status, ierr )
	766
	767	ENDIF
	768
	769	IF ( pdims(2) == 1 ) THEN
	770	!
	771	!-- One-dimensional decomposition along x, boundary values can be exchanged
	772	!-- within the PE memory
	773	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
	774	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
	775
	776
	777	ELSE
	778	!
	779	!-- Send front boundary, receive rear one
	780	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
	781	type_x_int(grid_level), psouth, 0, &
	782	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
	783	type_x_int(grid_level), pnorth, 0, &
	784	comm2d, status, ierr )
	785
	786	!
	787	!-- Send rear boundary, receive front one
	788	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
	789	type_x_int(grid_level), pnorth, 1, &
	790	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
	791	type_x_int(grid_level), psouth, 1, &
	792	comm2d, status, ierr )
	793
	794	ENDIF
	795
	796	#else
	797
	798	!
	799	!-- Lateral boundary conditions in the non-parallel case
	800	IF ( bc_lr_cyc ) THEN
	801	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
	802	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
	803	ENDIF
	804
	805	IF ( bc_ns_cyc ) THEN
	806	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
	807	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
	808	ENDIF
	809
	810	#endif
	811	!
	812	!-- Neumann-conditions at inflow/outflow/nested boundaries
	813	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
	814	DO i = nbgp_local, 1, -1
	815	ar(:,nxl_l-i) = ar(:,nxl_l)
	816	ENDDO
	817	ENDIF
	818	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
	819	DO i = 1, nbgp_local
	820	ar(:,nxr_l+i) = ar(:,nxr_l)
	821	ENDDO
	822	ENDIF
	823	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
	824	DO i = nbgp_local, 1, -1
	825	ar(nys_l-i,:) = ar(nys_l,:)
	826	ENDDO
	827	ENDIF
	828	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
	829	DO i = 1, nbgp_local
	830	ar(nyn_l+i,:) = ar(nyn_l,:)
	831	ENDDO
	832	ENDIF
	833
	834	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
	835
	836	END SUBROUTINE exchange_horiz_2d_int
	837
	838
	839	END MODULE exchange_horiz_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |