Changeset 13636
- Timestamp:
- 2020-10-19T16:15:38+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/lib_mpp.F90
r13438 r13636 511 511 ALLOCATE(todelay(idvar)%y1d(isz)) 512 512 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 513 ndelayid(idvar) = MPI_REQUEST_NULL ! initialised request to a valid value 513 514 END IF 514 515 ENDIF … … 518 519 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 519 520 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 520 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d521 ENDIF 522 523 IF( ndelayid(idvar) > 0 )CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received521 ndelayid(idvar) = MPI_REQUEST_NULL 522 ENDIF 523 524 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 524 525 525 526 ! send back pout from todelay(idvar)%z1d defined at previous call … … 530 531 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 531 532 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 532 ndelayid(idvar) = 1533 ndelayid(idvar) = MPI_REQUEST_NULL 533 534 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 534 535 # else … … 591 592 DEALLOCATE(todelay(idvar)%z1d) 592 593 ndelayid(idvar) = -1 ! do as if we had no restart 594 ELSE 595 ndelayid(idvar) = MPI_REQUEST_NULL 593 596 END IF 594 597 ENDIF … … 598 601 ALLOCATE(todelay(idvar)%z1d(isz)) 599 602 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 600 ENDIF 601 602 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 ndelayid(idvar) = MPI_REQUEST_NULL 604 ENDIF 605 606 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 607 604 608 ! send back pout from todelay(idvar)%z1d defined at previous call … … 606 610 607 611 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 612 ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 608 613 # if defined key_mpi2 609 614 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 610 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar),ierr )615 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ierr ) 611 616 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 612 617 # else … … 631 636 !!---------------------------------------------------------------------- 632 637 #if defined key_mpp_mpi 633 IF( ndelayid(kid) /= -2 ) THEN 634 #if ! defined key_mpi2 635 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 636 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 637 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 638 #endif 639 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 640 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 641 ENDIF 638 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 639 ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 640 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 641 IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 642 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 642 643 #endif 643 644 END SUBROUTINE mpp_delay_rcv
Note: See TracChangeset
for help on using the changeset viewer.