Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |