Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |