Home

Context Navigation

exchange_horiz.f90 @ 4454

Last change on this file since 4454 was 4429, checked in by raasch, 5 years ago
serial (non-MPI) test case added, several bugfixes for the serial mode
Property svn:keywords set to `Id`
File size: 13.6 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-2020 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: exchange_horiz.f90 4429 2020-02-27 15:24:30Z forkel $
27	! bugfix: cpp-directives added for serial mode
28	!
29	! 4360 2020-01-07 11:25:50Z suehring
30	! Corrected "Former revisions" section
31	!
32	! 3761 2019-02-25 15:31:42Z raasch
33	! OpenACC directives re-formatted
34	!
35	! 3657 2019-01-07 20:14:18Z knoop
36	! OpenACC port for SPEC
37	!
38	! Revision 1.1 1997/07/24 11:13:29 raasch
39	! Initial revision
40	!
41	!
42	! Description:
43	! ------------
44	!> Exchange of lateral boundary values (parallel computers) and cyclic
45	!> lateral boundary conditions, respectively.
46	!------------------------------------------------------------------------------!
47	SUBROUTINE exchange_horiz( ar, nbgp_local)
48
49
50	USE control_parameters, &
51	ONLY: bc_lr_cyc, bc_ns_cyc
52
53	#if defined( __parallel )
54	USE control_parameters, &
55	ONLY: grid_level, mg_switch_to_pe0, synchronous_exchange
56	#endif
57
58	USE cpulog, &
59	ONLY: cpu_log, log_point_s
60
61	USE indices, &
62	ONLY: nxl, nxr, nyn, nys, nzb, nzt
63
64	USE kinds
65
66	USE pegrid
67
68	IMPLICIT NONE
69
70
71	#if defined( _OPENACC )
72	INTEGER(iwp) :: i !<
73	#endif
74
75	INTEGER(iwp) :: nbgp_local !<
76
77	REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
78	nxl-nbgp_local:nxr+nbgp_local) :: ar !<
79
80
81	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
82
83	#if defined( _OPENACC )
84	!$ACC UPDATE IF_PRESENT ASYNC(1) &
85	!$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
86	!$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
87
88	!
89	!-- Wait for first UPDATE to complete before starting the others.
90	!$ACC WAIT(1) ASYNC(2)
91	! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
92	! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
93	DO i = nxl+nbgp_local, nxr-nbgp_local
94	!$ACC UPDATE IF_PRESENT ASYNC(2) &
95	!$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
96	!$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
97	ENDDO
98	! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
99	! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
100
101	!
102	!-- Wait for first UPDATE to complete before starting MPI.
103	!$ACC WAIT(1)
104	#endif
105
106	#if defined( __parallel )
107
108	!
109	!-- Exchange in x-direction of lateral boundaries
110	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
111	!
112	!-- One-dimensional decomposition along y, boundary values can be exchanged
113	!-- within the PE memory
114	IF ( bc_lr_cyc ) THEN
115	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
116	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
117	ENDIF
118
119	ELSE
120
121	IF ( synchronous_exchange ) THEN
122	!
123	!-- Send left boundary, receive right one (synchronous)
124	CALL MPI_SENDRECV( &
125	ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), pleft, 0, &
126	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), pright, 0, &
127	comm2d, status, ierr )
128	!
129	!-- Send right boundary, receive left one (synchronous)
130	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
131	type_yz(grid_level), pright, 1, &
132	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
133	type_yz(grid_level), pleft, 1, &
134	comm2d, status, ierr )
135
136	ELSE
137
138	!
139	!-- Asynchroneous exchange
140	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
141
142	req(1:4) = 0
143	req_count = 0
144	!
145	!-- Send left boundary, receive right one (asynchronous)
146	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), &
147	pleft, req_count, comm2d, req(req_count+1), ierr )
148	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), &
149	pright, req_count, comm2d, req(req_count+2), ierr )
150	!
151	!-- Send right boundary, receive left one (asynchronous)
152	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
153	type_yz(grid_level), pright, req_count+1, comm2d, &
154	req(req_count+3), ierr )
155	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
156	type_yz(grid_level), pleft, req_count+1, comm2d, &
157	req(req_count+4), ierr )
158
159	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
160
161	ENDIF
162
163	ENDIF
164
165	ENDIF
166
167	!$ACC UPDATE IF_PRESENT ASYNC(1) &
168	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
169	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
170
171	!
172	!-- Wait for UPDATES above to complete before starting MPI.
173	!$ACC WAIT(2)
174
175	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
176	!
177	!-- One-dimensional decomposition along x, boundary values can be exchanged
178	!-- within the PE memory
179	IF ( bc_ns_cyc ) THEN
180	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
181	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
182	ENDIF
183
184	ELSE
185
186	IF ( synchronous_exchange ) THEN
187	!
188	!-- Send front boundary, receive rear one (synchronous)
189	CALL MPI_SENDRECV( &
190	ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), psouth, 0, &
191	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), pnorth, 0, &
192	comm2d, status, ierr )
193	!
194	!-- Send rear boundary, receive front one (synchronous)
195	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
196	type_xz(grid_level), pnorth, 1, &
197	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
198	type_xz(grid_level), psouth, 1, &
199	comm2d, status, ierr )
200
201	ELSE
202
203	!
204	!-- Asynchroneous exchange
205	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
206
207	req(1:4) = 0
208	req_count = 0
209
210	!
211	!-- Send front boundary, receive rear one (asynchronous)
212	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), &
213	psouth, req_count, comm2d, req(req_count+1), ierr )
214	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), &
215	pnorth, req_count, comm2d, req(req_count+2), ierr )
216	!
217	!-- Send rear boundary, receive front one (asynchronous)
218	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
219	type_xz(grid_level), pnorth, req_count+1, comm2d, &
220	req(req_count+3), ierr )
221	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
222	type_xz(grid_level), psouth, req_count+1, comm2d, &
223	req(req_count+4), ierr )
224
225	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
226
227	ENDIF
228
229	ENDIF
230
231	ENDIF
232
233	#else
234
235	!
236	!-- Lateral boundary conditions in the non-parallel case.
237	!-- Case dependent, because in GPU mode still not all arrays are on device. This
238	!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
239	!-- with array syntax, explicit loops are used.
240	IF ( bc_lr_cyc ) THEN
241	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
242	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
243	ENDIF
244
245	!$ACC UPDATE IF_PRESENT ASYNC(1) &
246	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
247	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
248
249	!
250	!-- Wait for UPDATES above to complete before starting MPI.
251	!$ACC WAIT(2)
252
253	IF ( bc_ns_cyc ) THEN
254	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
255	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
256	ENDIF
257
258	#endif
259
260	#if defined( _OPENACC )
261	DO i = nxl-nbgp_local, nxr+nbgp_local
262	!$ACC UPDATE IF_PRESENT ASYNC(2) &
263	!$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
264	!$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
265	ENDDO
266
267	!
268	!-- Wait for all UPDATEs to finish.
269	!$ACC WAIT
270	#endif
271
272	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
273
274	END SUBROUTINE exchange_horiz
275
276
277	!------------------------------------------------------------------------------!
278	! Description:
279	! ------------
280	!> @todo Missing subroutine description.
281	!------------------------------------------------------------------------------!
282	SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
283
284
285	USE control_parameters, &
286	ONLY: bc_lr_cyc, bc_ns_cyc
287
288	#if defined( __parallel )
289	USE control_parameters, &
290	ONLY: grid_level
291	#endif
292
293	USE indices, &
294	ONLY: nzb
295
296	USE kinds
297
298	USE pegrid
299
300	IMPLICIT NONE
301
302	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
303	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
304	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
305	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
306	INTEGER(iwp) :: nzt_l !< local index bound at current grid level, top
307	INTEGER(iwp) :: nbgp_local !< number of ghost points
308
309	INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local, &
310	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
311
312
313	#if defined( __parallel )
314	IF ( pdims(1) == 1 ) THEN
315	!
316	!-- One-dimensional decomposition along y, boundary values can be exchanged
317	!-- within the PE memory
318	IF ( bc_lr_cyc ) THEN
319	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
320	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
321	ENDIF
322	ELSE
323	!
324	!-- Send left boundary, receive right one (synchronous)
325	CALL MPI_SENDRECV( &
326	ar(nzb,nys_l-nbgp_local,nxl_l), 1, type_yz_int(grid_level), pleft, 0,&
327	ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
328	comm2d, status, ierr )
329	!
330	!-- Send right boundary, receive left one (synchronous)
331	CALL MPI_SENDRECV( &
332	ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
333	pright, 1, &
334	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, type_yz_int(grid_level),&
335	pleft, 1, &
336	comm2d, status, ierr )
337	ENDIF
338
339
340	IF ( pdims(2) == 1 ) THEN
341	!
342	!-- One-dimensional decomposition along x, boundary values can be exchanged
343	!-- within the PE memory
344	IF ( bc_ns_cyc ) THEN
345	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
346	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
347	ENDIF
348
349	ELSE
350
351	!
352	!-- Send front boundary, receive rear one (synchronous)
353	CALL MPI_SENDRECV( &
354	ar(nzb,nys_l,nxl_l-nbgp_local), 1, type_xz_int(grid_level), psouth, 0,&
355	ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
356	comm2d, status, ierr )
357	!
358	!-- Send rear boundary, receive front one (synchronous)
359	CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1, &
360	type_xz_int(grid_level), pnorth, 1, &
361	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
362	type_xz_int(grid_level), psouth, 1, &
363	comm2d, status, ierr )
364
365	ENDIF
366
367	#else
368
369	IF ( bc_lr_cyc ) THEN
370	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
371	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
372	ENDIF
373
374	IF ( bc_ns_cyc ) THEN
375	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
376	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
377	ENDIF
378
379	#endif
380
381
382	END SUBROUTINE exchange_horiz_int

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

Context Navigation

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

Download in other formats: