Home

Context Navigation

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

Last change on this file since 4798 was 4626, checked in by raasch, 4 years ago
files re-formatted to follow the PALM coding standard
Property svn:keywords set to `Id`
File size: 33.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |