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

Last change on this file since 4274 was 4182, checked in by scharf, 5 years ago
  • corrected "Former revisions" section
  • minor formatting in "Former revisions" section
  • added "Author" section
  • Property svn:keywords set to Id
File size: 13.2 KB
RevLine 
[1682]1!> @file exchange_horiz.f90
[1320]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]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.
[1036]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!
[3655]17! Copyright 1997-2019 Leibniz Universitaet Hannover
[1320]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1]21! -----------------
[1678]22!
[2119]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: exchange_horiz.f90 4182 2019-08-22 15:20:23Z raasch $
[4182]27! Corrected "Former revisions" section
28!
29! 3761 2019-02-25 15:31:42Z raasch
[3761]30! OpenACC directives re-formatted
31!
32! 3657 2019-01-07 20:14:18Z knoop
[3634]33! OpenACC port for SPEC
[1321]34!
[4182]35! Revision 1.1  1997/07/24 11:13:29  raasch
36! Initial revision
37!
38!
[1]39! Description:
40! ------------
[1682]41!> Exchange of lateral boundary values (parallel computers) and cyclic
42!> lateral boundary conditions, respectively.
[1]43!------------------------------------------------------------------------------!
[1682]44 SUBROUTINE exchange_horiz( ar, nbgp_local)
45 
[1]46
[1320]47    USE control_parameters,                                                    &
[3761]48        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, mg_switch_to_pe0, synchronous_exchange
[1320]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   
[1]58    USE pegrid
59
60    IMPLICIT NONE
61
[841]62
[3761]63#if defined( _OPENACC )
[3634]64    INTEGER(iwp) ::  i           !<
65#endif
[3761]66
[1682]67    INTEGER(iwp) ::  nbgp_local  !<
[1320]68   
69    REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,               &
[1682]70                        nxl-nbgp_local:nxr+nbgp_local) ::  ar  !<
[1320]71                       
[841]72
[1]73    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
74
[3761]75#if defined( _OPENACC )
[3657]76    !$ACC UPDATE IF_PRESENT ASYNC(1) &
[3634]77    !$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
78    !$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
[3657]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) &
[3634]87       !$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
88       !$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
89    ENDDO
[3657]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)
[3634]96#endif
97
[1]98#if defined( __parallel )
99
100!
[1128]101!-- Exchange in x-direction of lateral boundaries
[1]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
[707]106       IF ( bc_lr_cyc )  THEN
[667]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)
[1]109       ENDIF
110
111    ELSE
[75]112
[683]113       IF ( synchronous_exchange )  THEN
[1]114!
[683]115!--       Send left boundary, receive right one (synchronous)
116          CALL MPI_SENDRECV(                                                   &
[707]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 )
[1]120!
[683]121!--       Send right boundary, receive left one (synchronous)
[1320]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,                   &
[707]126                             comm2d, status, ierr )
[667]127
[683]128       ELSE
[667]129
[683]130!
[2298]131!--       Asynchroneous exchange
[1128]132          IF ( send_receive == 'lr'  .OR.  send_receive == 'al' )  THEN
133
[2298]134             req(1:4)  = 0
135             req_count = 0
[683]136!
[1128]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)
[1320]144             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,       &
145                             type_yz(grid_level), pright, req_count+1, comm2d, &
[1128]146                             req(req_count+3), ierr )
[1320]147             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
148                             type_yz(grid_level), pleft,  req_count+1, comm2d, &
[1128]149                             req(req_count+4), ierr )
[667]150
[2298]151             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[75]152
[1128]153          ENDIF
154
[683]155       ENDIF
156
[1]157    ENDIF
158
[3657]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))
[1]162
[3657]163!
164!-- Wait for UPDATES above to complete before starting MPI.
165    !$ACC WAIT(2)
166
[1]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
[707]171       IF ( bc_ns_cyc )  THEN
[667]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,:)
[1]174       ENDIF
175
176    ELSE
177
[683]178       IF ( synchronous_exchange )  THEN
[1]179!
[683]180!--       Send front boundary, receive rear one (synchronous)
181          CALL MPI_SENDRECV(                                                   &
[707]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 )
[683]185!
186!--       Send rear boundary, receive front one (synchronous)
[1320]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,                   &
[707]191                             comm2d, status, ierr )
[667]192
[683]193       ELSE
194
[1]195!
[2298]196!--       Asynchroneous exchange
[1569]197          IF ( send_receive == 'ns'  .OR.  send_receive == 'al' )  THEN
[1128]198
[2298]199             req(1:4)  = 0
200             req_count = 0
[1128]201
[683]202!
[1128]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)
[1320]210             CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,       &
211                             type_xz(grid_level), pnorth, req_count+1, comm2d, &
[1128]212                             req(req_count+3), ierr )
[1320]213             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
214                             type_xz(grid_level), psouth, req_count+1, comm2d, &
[1128]215                             req(req_count+4), ierr )
[75]216
[2298]217             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
[683]218
[1128]219          ENDIF
220
[683]221       ENDIF
222
[1]223    ENDIF
224
225#else
226
227!
[1113]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.
[3241]232    IF ( bc_lr_cyc )  THEN
[2118]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)
[1]235    ENDIF
236
[3657]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
[3241]245    IF ( bc_ns_cyc )  THEN
[2118]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,:)
[1]248    ENDIF
249
250#endif
[3634]251
[3761]252#if defined( _OPENACC )
[3634]253    DO i = nxl-nbgp_local, nxr+nbgp_local
[3657]254       !$ACC UPDATE IF_PRESENT ASYNC(2) &
[3634]255       !$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
256       !$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
257    ENDDO
[3657]258
259!
260!-- Wait for all UPDATEs to finish.
261    !$ACC WAIT
[3634]262#endif
263
[1]264    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
265
266 END SUBROUTINE exchange_horiz
[1677]267
268
[1682]269!------------------------------------------------------------------------------!
270! Description:
271! ------------
272!> @todo Missing subroutine description.
273!------------------------------------------------------------------------------!
[2696]274 SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local)
[1677]275
276    USE control_parameters,                                                    &
[3241]277        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level
[1677]278                       
279    USE indices,                                                               &
[3241]280        ONLY:  nzb
[1677]281       
282    USE kinds
283   
284    USE pegrid
285
286    IMPLICIT NONE
287
[2696]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
[1682]293    INTEGER(iwp) ::  nbgp_local  !< number of ghost points
[1677]294   
[2696]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
[1677]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
[2696]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)
[1677]307       ENDIF
308    ELSE
309!
310!--    Send left boundary, receive right one (synchronous)
[2696]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,&
[1677]314           comm2d, status, ierr )
315!
316!--    Send right boundary, receive left one (synchronous)
[2696]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,                                                              &
[1677]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
[2696]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,:)
[1677]333       ENDIF
334
335    ELSE
336
337!
338!--    Send front boundary, receive rear one (synchronous)
[2696]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,&
[1677]342           comm2d, status, ierr )
343!
344!--    Send rear boundary, receive front one (synchronous)
[2696]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,                      &
[1677]349                          comm2d, status, ierr )
350
351    ENDIF
352
353#else
354
[3241]355    IF ( bc_lr_cyc )  THEN
[2696]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)
[1677]358    ENDIF
359
[3241]360    IF ( bc_ns_cyc )  THEN
[2696]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,:)
[1677]363    ENDIF
364
365#endif
366
367
[1933]368 END SUBROUTINE exchange_horiz_int
Note: See TracBrowser for help on using the repository browser.