Home

Context Navigation

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

Last change on this file since 2186 was 2119, checked in by raasch, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 13.0 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |