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