Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |