Home

Context Navigation

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

Last change on this file since 1886 was 1818, checked in by maronga, 9 years ago
last commit documented / copyright update
Property svn:keywords set to `Id`
File size: 13.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |