Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |