Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |