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

Last change on this file since 3736 was 3657, checked in by knoop, 5 years ago

OpenACC: cuda-aware-mpi in transpose and acc update async in exchange_horiz added

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