Changeset 13635 for NEMO/releases/r4.0/r4.0-HEAD/src/OCE
- Timestamp:
- 2020-10-19T16:14:38+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/LBC/lib_mpp.F90
r13061 r13635 380 380 ALLOCATE(todelay(idvar)%y1d(isz)) 381 381 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 382 ndelayid(idvar) = MPI_REQUEST_NULL ! initialised request to a valid value 382 383 END IF 383 384 ENDIF … … 387 388 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 388 389 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 389 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d390 ENDIF 391 392 IF( ndelayid(idvar) > 0 )CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received390 ndelayid(idvar) = MPI_REQUEST_NULL 391 ENDIF 392 393 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 393 394 394 395 ! send back pout from todelay(idvar)%z1d defined at previous call … … 399 400 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 400 401 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 401 ndelayid(idvar) = 1402 ndelayid(idvar) = MPI_REQUEST_NULL 402 403 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 403 404 # else … … 429 430 INTEGER :: ierr, ilocalcomm 430 431 !!---------------------------------------------------------------------- 432 431 433 #if defined key_mpp_mpi 432 434 ilocalcomm = mpi_comm_oce … … 449 451 DEALLOCATE(todelay(idvar)%z1d) 450 452 ndelayid(idvar) = -1 ! do as if we had no restart 453 ELSE 454 ndelayid(idvar) = MPI_REQUEST_NULL 451 455 END IF 452 456 ENDIF … … 456 460 ALLOCATE(todelay(idvar)%z1d(isz)) 457 461 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 458 ENDIF 459 460 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 462 ndelayid(idvar) = MPI_REQUEST_NULL 463 ENDIF 464 465 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 461 466 462 467 ! send back pout from todelay(idvar)%z1d defined at previous call … … 464 469 465 470 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 471 ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 466 472 # if defined key_mpi2 467 473 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 468 474 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) 469 ndelayid(idvar) = 1470 475 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 471 476 # else … … 490 495 !!---------------------------------------------------------------------- 491 496 #if defined key_mpp_mpi 492 IF( ndelayid(kid) /= -2 ) THEN 493 #if ! defined key_mpi2 494 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 495 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 496 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 497 #endif 498 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 499 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 500 ENDIF 497 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 498 ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 499 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 500 IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 501 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 501 502 #endif 502 503 END SUBROUTINE mpp_delay_rcv
Note: See TracChangeset
for help on using the changeset viewer.