Home

Context Navigation

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

Last change on this file since 3655 was 3655, checked in by knoop, 5 years ago
Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update
Property svn:keywords set to `Id`
File size: 14.1 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 3655 2019-01-07 16:51:22Z knoop $
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 &
135	!$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
136	!$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
137	DO i = nxl-nbgp_local, nxr+nbgp_local
138	!$ACC UPDATE IF_PRESENT &
139	!$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
140	!$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
141	ENDDO
142	#endif
143
144	#if defined( __parallel )
145
146	!
147	!-- Exchange in x-direction of lateral boundaries
148	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
149	!
150	!-- One-dimensional decomposition along y, boundary values can be exchanged
151	!-- within the PE memory
152	IF ( bc_lr_cyc ) THEN
153	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
154	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
155	ENDIF
156
157	ELSE
158
159	IF ( synchronous_exchange ) THEN
160	!
161	!-- Send left boundary, receive right one (synchronous)
162	CALL MPI_SENDRECV( &
163	ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), pleft, 0, &
164	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), pright, 0, &
165	comm2d, status, ierr )
166	!
167	!-- Send right boundary, receive left one (synchronous)
168	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
169	type_yz(grid_level), pright, 1, &
170	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
171	type_yz(grid_level), pleft, 1, &
172	comm2d, status, ierr )
173
174	ELSE
175
176	!
177	!-- Asynchroneous exchange
178	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
179
180	req(1:4) = 0
181	req_count = 0
182	!
183	!-- Send left boundary, receive right one (asynchronous)
184	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), &
185	pleft, req_count, comm2d, req(req_count+1), ierr )
186	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), &
187	pright, req_count, comm2d, req(req_count+2), ierr )
188	!
189	!-- Send right boundary, receive left one (asynchronous)
190	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
191	type_yz(grid_level), pright, req_count+1, comm2d, &
192	req(req_count+3), ierr )
193	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
194	type_yz(grid_level), pleft, req_count+1, comm2d, &
195	req(req_count+4), ierr )
196
197	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
198
199	ENDIF
200
201	ENDIF
202
203	ENDIF
204
205
206	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
207	!
208	!-- One-dimensional decomposition along x, boundary values can be exchanged
209	!-- within the PE memory
210	IF ( bc_ns_cyc ) THEN
211	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
212	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
213	ENDIF
214
215	ELSE
216
217	IF ( synchronous_exchange ) THEN
218	!
219	!-- Send front boundary, receive rear one (synchronous)
220	CALL MPI_SENDRECV( &
221	ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), psouth, 0, &
222	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), pnorth, 0, &
223	comm2d, status, ierr )
224	!
225	!-- Send rear boundary, receive front one (synchronous)
226	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
227	type_xz(grid_level), pnorth, 1, &
228	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
229	type_xz(grid_level), psouth, 1, &
230	comm2d, status, ierr )
231
232	ELSE
233
234	!
235	!-- Asynchroneous exchange
236	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
237
238	req(1:4) = 0
239	req_count = 0
240
241	!
242	!-- Send front boundary, receive rear one (asynchronous)
243	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), &
244	psouth, req_count, comm2d, req(req_count+1), ierr )
245	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), &
246	pnorth, req_count, comm2d, req(req_count+2), ierr )
247	!
248	!-- Send rear boundary, receive front one (asynchronous)
249	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
250	type_xz(grid_level), pnorth, req_count+1, comm2d, &
251	req(req_count+3), ierr )
252	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
253	type_xz(grid_level), psouth, req_count+1, comm2d, &
254	req(req_count+4), ierr )
255
256	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
257
258	ENDIF
259
260	ENDIF
261
262	ENDIF
263
264	#else
265
266	!
267	!-- Lateral boundary conditions in the non-parallel case.
268	!-- Case dependent, because in GPU mode still not all arrays are on device. This
269	!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
270	!-- with array syntax, explicit loops are used.
271	IF ( bc_lr_cyc ) THEN
272	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
273	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
274	ENDIF
275
276	IF ( bc_ns_cyc ) THEN
277	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
278	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
279	ENDIF
280
281	#endif
282
283	#ifdef _OPENACC
284	!$ACC UPDATE IF_PRESENT &
285	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
286	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
287	DO i = nxl-nbgp_local, nxr+nbgp_local
288	!$ACC UPDATE IF_PRESENT &
289	!$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
290	!$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
291	ENDDO
292	#endif
293
294	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
295
296	END SUBROUTINE exchange_horiz
297
298
299	!------------------------------------------------------------------------------!
300	! Description:
301	! ------------
302	!> @todo Missing subroutine description.
303	!------------------------------------------------------------------------------!
304	SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local)
305
306	USE control_parameters, &
307	ONLY: bc_lr_cyc, bc_ns_cyc, grid_level
308
309	USE indices, &
310	ONLY: nzb
311
312	USE kinds
313
314	USE pegrid
315
316	IMPLICIT NONE
317
318	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
319	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
320	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
321	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
322	INTEGER(iwp) :: nzt_l !< local index bound at current grid level, top
323	INTEGER(iwp) :: nbgp_local !< number of ghost points
324
325	INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local, &
326	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
327
328
329	#if defined( __parallel )
330	IF ( pdims(1) == 1 ) THEN
331	!
332	!-- One-dimensional decomposition along y, boundary values can be exchanged
333	!-- within the PE memory
334	IF ( bc_lr_cyc ) THEN
335	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
336	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
337	ENDIF
338	ELSE
339	!
340	!-- Send left boundary, receive right one (synchronous)
341	CALL MPI_SENDRECV( &
342	ar(nzb,nys_l-nbgp_local,nxl_l), 1, type_yz_int(grid_level), pleft, 0,&
343	ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
344	comm2d, status, ierr )
345	!
346	!-- Send right boundary, receive left one (synchronous)
347	CALL MPI_SENDRECV( &
348	ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
349	pright, 1, &
350	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, type_yz_int(grid_level),&
351	pleft, 1, &
352	comm2d, status, ierr )
353	ENDIF
354
355
356	IF ( pdims(2) == 1 ) THEN
357	!
358	!-- One-dimensional decomposition along x, boundary values can be exchanged
359	!-- within the PE memory
360	IF ( bc_ns_cyc ) THEN
361	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
362	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
363	ENDIF
364
365	ELSE
366
367	!
368	!-- Send front boundary, receive rear one (synchronous)
369	CALL MPI_SENDRECV( &
370	ar(nzb,nys_l,nxl_l-nbgp_local), 1, type_xz_int(grid_level), psouth, 0,&
371	ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
372	comm2d, status, ierr )
373	!
374	!-- Send rear boundary, receive front one (synchronous)
375	CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1, &
376	type_xz_int(grid_level), pnorth, 1, &
377	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
378	type_xz_int(grid_level), psouth, 1, &
379	comm2d, status, ierr )
380
381	ENDIF
382
383	#else
384
385	IF ( bc_lr_cyc ) THEN
386	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
387	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
388	ENDIF
389
390	IF ( bc_ns_cyc ) THEN
391	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
392	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
393	ENDIF
394
395	#endif
396
397
398	END SUBROUTINE exchange_horiz_int

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |