Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |