MODULE MPL_BROADCAST_MOD

!**** MPL_BROADCAST Message broadcast

!     Purpose.
!     --------
!     Broadcasts a message from the process with rank root
!     to all processes in the group.

!**   Interface.
!     ----------
!        CALL MPL_BROADCAST

!        Input required arguments :
!        -------------------------
!           PBUF     -  buffer containing message
!                       (can be type REAL*4, REAL*8 or INTEGER)
!           KTAG     -  message tag

!        Input optional arguments :
!        -------------------------
!           KROOT    -  number of root process (default=1)
!           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_BROADCAST aborts when an error is detected.
!     Author.
!     -------
!        D.Dent, M.Hamrud, S.Saarinen    ECMWF

!     Modifications.
!     --------------
!        Original: 2000-09-01

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB     ,JPRM

USE MPL_MPIF
USE MPL_DATA_MODULE
USE MPL_MESSAGE_MOD
USE MPL_SEND_MOD
USE MPL_RECV_MOD
USE MPL_BARRIER_MOD
USE MPL_MYRANK_MOD

IMPLICIT NONE
PRIVATE

!--- Move to reoutines to make thread safe ----------------
! INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
! INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
! INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS

LOGICAL :: LLABORT=.TRUE.

INTERFACE MPL_BROADCAST
MODULE PROCEDURE MPL_BROADCAST_REAL4,MPL_BROADCAST_REAL8, &
     & MPL_BROADCAST_REAL42,MPL_BROADCAST_REAL82,MPL_BROADCAST_REAL83,&
     & MPL_BROADCAST_REAL84,MPL_BROADCAST_REAL8_SCALAR, &
     & MPL_BROADCAST_INT,MPL_BROADCAST_INT2,MPL_BROADCAST_INT_SCALAR, &
     & MPL_BROADCAST_CHAR_SCALAR
END INTERFACE

PUBLIC MPL_BROADCAST

CONTAINS

SUBROUTINE MPL_BROADCAST_PREAMB1(KCOMM,KROOT)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8
#endif



INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF


END SUBROUTINE MPL_BROADCAST_PREAMB1

SUBROUTINE MPL_BROADCAST_REAL4(PBUF,KTAG,KROOT,&
                               KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


REAL(KIND=JPRM)            :: PBUF(:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = SIZE(PBUF)

CALL MPI_BCAST(PBUF,ICOUNT,INT(MPI_REAL4),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL4

SUBROUTINE MPL_BROADCAST_REAL8(PBUF,KTAG,KROOT,&
                               KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


REAL(KIND=JPRB)            :: PBUF(:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF


CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = SIZE(PBUF)

CALL MPI_BCAST(PBUF,ICOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL8


SUBROUTINE MPL_BROADCAST_REAL42(PBUF,KTAG,KROOT,KCOMM,KERROR,CDSTRING)

REAL(KIND=JPRM)            :: PBUF(:,:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS

IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

IROWS=SIZE(PBUF,DIM=1)
ICOLS=SIZE(PBUF,DIM=2)
DO JCOL=1,ICOLS
  CALL MPL_BROADCAST(PBUF(1:IROWS,JCOL),KTAG,KROOT,KCOMM,KERROR,CDSTRING)
ENDDO

END SUBROUTINE MPL_BROADCAST_REAL42


SUBROUTINE MPL_BROADCAST_REAL82(PBUF,KTAG,KROOT,&
                                KCOMM,KERROR,CDSTRING)

#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif

REAL(KIND=JPRB)            :: PBUF(:,:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF


CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------


ICOUNT = SIZE(PBUF)
#ifndef NAG
IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2))) - &
   & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2)))) /= 8*(ICOUNT - 1) .AND. ICOUNT > 0 ) THEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT)
ENDIF
#endif
CALL MPI_BCAST(PBUF(1,1),ICOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL82

SUBROUTINE MPL_BROADCAST_REAL83(PBUF,KTAG,KROOT,&
                                KCOMM,KERROR,CDSTRING)

#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


REAL(KIND=JPRB)            :: PBUF(:,:,:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF


CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------


ICOUNT = SIZE(PBUF)
#ifndef NAG
IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - &
  &  LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 8*(ICOUNT - 1) .AND. &
  & ICOUNT > 0 ) THEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT)
ENDIF
#endif
CALL MPI_BCAST(PBUF(1,1,1),ICOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL83

SUBROUTINE MPL_BROADCAST_REAL84(PBUF,KTAG,KROOT,&
                                KCOMM,KERROR,CDSTRING)

#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


REAL(KIND=JPRB)            :: PBUF(:,:,:,:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF


CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------


ICOUNT = SIZE(PBUF)
#ifndef NAG
IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3),UBOUND(PBUF,4))) - &
  &  LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3),LBOUND(PBUF,4)))) /= 8*(ICOUNT - 1) .AND. &
  & ICOUNT > 0 ) THEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT)
ENDIF
#endif
CALL MPI_BCAST(PBUF(1,1,1,1),ICOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL84


SUBROUTINE MPL_BROADCAST_REAL8_SCALAR(PBUF,KTAG,KROOT,&
                                      KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


REAL(KIND=JPRB)            :: PBUF
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF


CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = 1

CALL MPI_BCAST(PBUF,ICOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_REAL8_SCALAR


SUBROUTINE MPL_BROADCAST_INT(KBUF,KTAG,KROOT,&
                             KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


INTEGER(KIND=JPIM)           :: KBUF(:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = SIZE(KBUF)

CALL MPI_BCAST(KBUF,ICOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_INT


SUBROUTINE MPL_BROADCAST_INT2(KBUF,KTAG,KROOT,&
                              KCOMM,KERROR,CDSTRING)

INTEGER(KIND=JPIM)           :: KBUF(:,:)
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS

IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

IROWS=SIZE(KBUF,DIM=1)
ICOLS=SIZE(KBUF,DIM=2)
DO JCOL=1,ICOLS
  CALL MPL_BROADCAST(KBUF(1:IROWS,JCOL),KTAG,KROOT,KCOMM,KERROR,CDSTRING)
ENDDO

END SUBROUTINE MPL_BROADCAST_INT2


SUBROUTINE MPL_BROADCAST_INT_SCALAR(KBUF,KTAG,KROOT,&
                                    KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


INTEGER(KIND=JPIM)           :: KBUF
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = 1


CALL MPI_BCAST(KBUF,ICOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_INT_SCALAR


SUBROUTINE MPL_BROADCAST_CHAR_SCALAR(CDBUF,KTAG,KROOT,&
                                    KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_BCAST => MPI_BCAST8
#endif


CHARACTER*(*)                          :: CDBUF
INTEGER(KIND=JPIM),INTENT(IN)          :: KTAG
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IPROC,IROOT,IOUNT,IPL_NUMPROC,IPL_MYRANK
INTEGER(KIND=JPIM) :: IMAXMSG, ICHUNKS, ISTS, IENS, ILENS, ITAG, IDUM, JMESS
INTEGER(KIND=JPIM) :: JCOL, IROWS, ICOLS
INTEGER(KIND=JPIM) :: ITID
ITID = OML_MY_THREAD()
IF (MPL_NUMPROC == 1) THEN
  IF(PRESENT(KERROR)) THEN
    KERROR=0
  ENDIF
  RETURN
ENDIF

CALL MPL_BROADCAST_PREAMB1(KCOMM,KROOT)

!----- Repeat Preamble to make threadsafe----------
IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_BROADCAST: MPL NOT INITIALISED ',LDABORT=LLABORT) 

IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(ICOMM == MPL_COMM_OML(ITID)) THEN
  IPL_NUMPROC = MPL_NUMPROC
  IPL_MYRANK  = MPL_RANK
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
  IPL_MYRANK  = MPL_MYRANK(ICOMM)
ENDIF

IF(PRESENT(KROOT)) THEN
  IROOT=KROOT
ELSE
  IROOT=1
ENDIF
!----- End Preamble ----------------------------

ICOUNT = LEN(CDBUF)


CALL MPI_BCAST(CDBUF,ICOUNT,INT(MPI_BYTE),IROOT-1,ICOMM,IERROR)

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BROADCAST',CDSTRING,LDABORT=LLABORT)
ENDIF


END SUBROUTINE MPL_BROADCAST_CHAR_SCALAR


END MODULE MPL_BROADCAST_MOD
