Changeset 13636


Ignore:
Timestamp:
2020-10-19T16:15:38+02:00 (6 months ago)
Author:
mathiot
Message:

fix ticket #2551 in trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r13438 r13636  
    511511            ALLOCATE(todelay(idvar)%y1d(isz)) 
    512512            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 
    513514         END IF 
    514515      ENDIF 
     
    518519         ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz))   ! allocate also %z1d as used for the restart 
    519520         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 %y1d 
    521       ENDIF 
    522  
    523       IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
     521         ndelayid(idvar) = MPI_REQUEST_NULL 
     522      ENDIF 
     523 
     524      CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
    524525 
    525526      ! send back pout from todelay(idvar)%z1d defined at previous call 
     
    530531      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    531532      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 
    532       ndelayid(idvar) = 1 
     533      ndelayid(idvar) = MPI_REQUEST_NULL 
    533534      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    534535# else 
     
    591592            DEALLOCATE(todelay(idvar)%z1d) 
    592593            ndelayid(idvar) = -1                                      ! do as if we had no restart 
     594         ELSE 
     595            ndelayid(idvar) = MPI_REQUEST_NULL 
    593596         END IF 
    594597      ENDIF 
     
    598601         ALLOCATE(todelay(idvar)%z1d(isz)) 
    599602         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 
    603607 
    604608      ! send back pout from todelay(idvar)%z1d defined at previous call 
     
    606610 
    607611      ! 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 ? 
    608613# if defined key_mpi2 
    609614      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 ) 
    611616      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    612617# else 
     
    631636      !!---------------------------------------------------------------------- 
    632637#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 
    642643#endif 
    643644   END SUBROUTINE mpp_delay_rcv 
Note: See TracChangeset for help on using the changeset viewer.