mpl_barrier_mod.F90

Go to the documentation of this file.

MODULE mpl_barrier_mod

!**** MPL_BARRIER - Barrier synchronisation

!     Purpose.
!     --------
!     Blocks the caller until all group members have called it.

!**   Interface.
!     ----------
!        CALL MPL_BARRIER

!        Input required arguments :
!        -------------------------
!           none

!        Input optional arguments :
!        -------------------------
!           KCOMM    -  Communicator number if different from MPI_COMM_WORLD 
!                       or from that established as the default 
!                       by an MPL communicator routine
!           CDSTRING -  Character string for ABORT messages
!                       used when KERROR is not provided

!        Output required arguments :
!        -------------------------
!           none

!        Output optional arguments :
!        -------------------------
!           KERROR   -  return error code.     If not supplied, 
!                       MPL_BARRIER aborts when an error is detected.
!     Author.
!     -------
!        D.Dent, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original: 2000-09-01
!        Threadsafe: 2004-12-15, J.Hague

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

USE parkind1  ,ONLY : jpim     ,jprb

USE mpl_data_module
USE mpl_message_mod

IMPLICIT NONE


PRIVATE

LOGICAL :: llabort=.true.

PUBLIC mpl_barrier

CONTAINS

SUBROUTINE mpl_barrier(KCOMM,CDSTRING,KERROR)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_barrier => mpi_barrier8
#endif


INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL   :: KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL  :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
INTEGER :: ICOMM,IERROR,ITID
ierror = 0
itid = oml_my_thread()
IF(mpl_numproc < 1) CALL mpl_message(cdstring=cdstring,&
  & cdmessage='MPL_BARRIER: MPL NOT INITIALISED ',ldabort=llabort)
 
IF(PRESENT(kcomm)) THEN
  icomm=kcomm
ELSE
  icomm=mpl_comm_oml(itid)
ENDIF

#ifdef VPP
  CALL vpp_barrier
#else
  CALL mpi_barrier(icomm,ierror)
#endif

IF(PRESENT(kerror)) THEN
  kerror=ierror
ELSE
  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BARRIER',cdstring,ldabort=llabort)
ENDIF
  
RETURN
END SUBROUTINE mpl_barrier

END MODULE mpl_barrier_mod