- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/LBC/lib_mpp.F90
r13226 r13899 73 73 PUBLIC tic_tac 74 74 #if ! defined key_mpp_mpi 75 PUBLIC MPI_wait 75 76 PUBLIC MPI_Wtime 76 77 #endif … … 115 116 #else 116 117 INTEGER, PUBLIC, PARAMETER :: MPI_STATUS_SIZE = 1 118 INTEGER, PUBLIC, PARAMETER :: MPI_REAL = 4 117 119 INTEGER, PUBLIC, PARAMETER :: MPI_DOUBLE_PRECISION = 8 118 120 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag … … 509 511 ALLOCATE(todelay(idvar)%y1d(isz)) 510 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 511 514 END IF 512 515 ENDIF … … 516 519 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 517 520 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 518 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d519 ENDIF 520 521 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 522 525 523 526 ! send back pout from todelay(idvar)%z1d defined at previous call … … 528 531 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 529 532 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 530 ndelayid(idvar) = 1533 ndelayid(idvar) = MPI_REQUEST_NULL 531 534 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 532 535 # else … … 589 592 DEALLOCATE(todelay(idvar)%z1d) 590 593 ndelayid(idvar) = -1 ! do as if we had no restart 594 ELSE 595 ndelayid(idvar) = MPI_REQUEST_NULL 591 596 END IF 592 597 ENDIF … … 596 601 ALLOCATE(todelay(idvar)%z1d(isz)) 597 602 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 598 ENDIF 599 600 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 601 607 602 608 ! send back pout from todelay(idvar)%z1d defined at previous call … … 604 610 605 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 ? 606 613 # if defined key_mpi2 607 614 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 608 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 ) 609 616 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 610 617 # else … … 629 636 !!---------------------------------------------------------------------- 630 637 #if defined key_mpp_mpi 631 IF( ndelayid(kid) /= -2 ) THEN 632 #if ! defined key_mpi2 633 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 634 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 635 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 636 #endif 637 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 638 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 639 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 640 643 #endif 641 644 END SUBROUTINE mpp_delay_rcv … … 1098 1101 ! Look for how many procs on the northern boundary 1099 1102 ndim_rank_north = 0 1100 DO jjproc = 1, jpni j1101 IF( n jmppt(jjproc) == njmppmax) ndim_rank_north = ndim_rank_north + 11103 DO jjproc = 1, jpni 1104 IF( nfproc(jjproc) /= -1 ) ndim_rank_north = ndim_rank_north + 1 1102 1105 END DO 1103 1106 ! … … 1109 1112 ! Note : the rank start at 0 in MPI 1110 1113 ii = 0 1111 DO ji = 1, jpni j1112 IF ( n jmppt(ji) == njmppmax) THEN1114 DO ji = 1, jpni 1115 IF ( nfproc(ji) /= -1 ) THEN 1113 1116 ii=ii+1 1114 nrank_north(ii)= ji-11117 nrank_north(ii)=nfproc(ji) 1115 1118 END IF 1116 1119 END DO
Note: See TracChangeset
for help on using the changeset viewer.