mpl_waitany_mod.F90

Go to the documentation of this file.

MODULE mpl_waitany_mod

!**** MPL_WAITANY Waits for completion of any request

!     Purpose.
!     --------
!     Returns control when any operation identified by the request
!     is completed.
!     Normally used in conjunction with non-blocking buffering type

!**   Interface.
!     ----------
!        CALL MPL_WAITANY

!        Input required arguments :
!        -------------------------
!           KREQUEST -  array or scalar containing
!                       Communication request(s)
!                       as provided by MPL_RECV or MPL_SEND

!        Input optional arguments :
!        -------------------------
!           CDSTRING -  Character string for ABORT messages
!                       used when KERROR is not provided

!        Output required arguments :
!        -------------------------
!           KINDEX - index of received request

!        Output optional arguments :
!        -------------------------
!           KERROR   -  return error code.     If not supplied, 
!                       MPL_WAITANY aborts when an error is detected.
!     Author.
!     -------
!        R. El Khatib *Meteo-France*

!     Modifications.
!     --------------
!        Original: 02-Sep-2014

!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb     ,jprm, jpib

USE mpl_mpif
USE mpl_data_module
USE mpl_message_mod

IMPLICIT NONE

PRIVATE
PUBLIC mpl_waitany

CONTAINS 

SUBROUTINE mpl_waitany(KREQUEST,KINDEX,CDSTRING,KERROR)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_waitany => mpi_waitany8
#endif

INTEGER(KIND=JPIM),INTENT(IN)           :: KREQUEST(:)
INTEGER(KIND=JPIM),INTENT(OUT)          :: KINDEX
CHARACTER*(*)     ,INTENT(IN), OPTIONAL :: CDSTRING
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR

INTEGER(KIND=JPIM) :: IWAITERR,IREQLEN
INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
LOGICAL :: LLABORT
llabort=.true.
iwaiterr=0

IF(mpl_numproc < 1) CALL mpl_message( &
  & cdmessage='MPL_WAITANY: MPL NOT INITIALISED ',ldabort=llabort) 

ireqlen=SIZE(krequest)

#ifndef MPI1
CALL mpi_waitany(ireqlen,krequest,kindex,iwait_status,iwaiterr)
#else

CALL abor1('MPI_WAITANY not built with MPI2')

#endif


IF(PRESENT(kerror))THEN
  kerror=iwaiterr
ELSE IF(iwaiterr /= 0) THEN
  CALL mpl_message(iwaiterr,'MPL_WAITANY_WAITING',cdstring,ldabort=llabort)
ENDIF

RETURN
END SUBROUTINE mpl_waitany


END MODULE mpl_waitany_mod