Home

Context Navigation

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

Last change on this file since 3760 was 3657, checked in by knoop, 6 years ago
OpenACC: cuda-aware-mpi in transpose and acc update async in exchange_horiz added
Property svn:keywords set to `Id`
File size: 14.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |