Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |