Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |