MODULE MPL_SCATTERV_MOD

!**** MPL_SCATTERV Scatter data from specific processor

!     Purpose.
!     --------
!     Scatter data from specific processor
!     The data may be REAL*8,or INTEGER, one dimensional array
!
!**   Interface.
!     ----------
!        CALL MPL_SCATTERV

!        Input required arguments :
!        -------------------------
!           PRECVBUF -  buffer containing message
!                       (can be type REAL*4, REAL*8 or INTEGER)
!           PSENDBUF -  buffer containing message 
!                       (required from kroot)
!                       (can be type REAL*4, REAL*8 or INTEGER)
!           KSENDCOUNTS-number of elements to be sent to each process
!                       (required from kroot processor)

!        Input optional arguments :
!        -------------------------
!           KROOT    -  rank of sending processor (default 1) 
!           KCOMM    -  Communicator number if different from MPI_COMM_WORLD 
!                       or from that established as the default 
!                       by an MPL communicator routine
!           KSENDDISPL -displacements in PRECVBUF at which to place 
!                       the incoming data
!           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_SCATTERV aborts when an error is detected.
!     Author.
!     -------
!        Y. Tremolet, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original: 02-03-13

! --- *NOT* THREAD SAFE YET ---

!     ----------------------------------------------------------------
USE PARKIND1  ,ONLY : JPIM     ,JPRB

USE MPL_MPIF
USE MPL_DATA_MODULE
USE MPL_MESSAGE_MOD
USE MPL_MYRANK_MOD

IMPLICIT NONE
PRIVATE
PUBLIC MPL_SCATTERV

INTEGER(KIND=JPIM) :: ICOMM,IROOT,IPL_NUMPROC,IRECVCOUNT,ISENDBUFSIZE,IR,IPL_MYRANK
LOGICAL   :: LLABORT=.TRUE.
INTEGER(KIND=JPIM) :: IERROR,IDUM
REAL(KIND=JPRB)    :: ZDUM
INTEGER(KIND=JPIM)    :: ZDUM_INT

INTERFACE MPL_SCATTERV
MODULE PROCEDURE MPL_SCATTERV_REAL8,MPL_SCATTERV_INTEGER
END INTERFACE

CONTAINS

SUBROUTINE MPL_SCATTERV_PREAMB1(KCOMM,KROOT)


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



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

IERROR = 0

IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_SCATTERV: 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_SCATTERV_PREAMB1

SUBROUTINE MPL_SCATTERV_PREAMB2(KSENDCOUNTS,KISENDDISPL,KSENDDISPL,CDSTRING)

INTEGER(KIND=JPIM),INTENT(IN) :: KSENDCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KSENDDISPL(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KISENDDISPL(:) 
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING


IF(SIZE(KSENDCOUNTS)  < IPL_NUMPROC) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_SCATTERV: ERROR KSENDCOUNTS DIMENSION=',&
   & SIZE(KSENDCOUNTS)
  CALL MPL_MESSAGE(CDMESSAGE=&
   & 'MPL_SCATTERV: ERROR KSENDCOUNTS DIMENSION IS WRONG',LDABORT=LLABORT)
ENDIF
IF(IRECVCOUNT /= KSENDCOUNTS(IPL_MYRANK)) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_SCATTERV: ERROR KSENDCOUNTS INCONSISTENCY ',&
   & IRECVCOUNT,KSENDCOUNTS(IPL_MYRANK)
  CALL MPL_MESSAGE(CDMESSAGE=&
   & 'MPL_SCATTERV: ERROR IRECVCOUNT /= KSENDCOUNTS(MPL_RANK) ',LDABORT=LLABORT)
ENDIF

IF(PRESENT(KSENDDISPL)) THEN
  KISENDDISPL(:) = KSENDDISPL(:)
ELSE
  KISENDDISPL(:) = 0
  DO IR=2, IPL_NUMPROC
    KISENDDISPL(IR) = KISENDDISPL(IR-1) + KSENDCOUNTS(IR-1)
  ENDDO
ENDIF
DO IR=1, IPL_NUMPROC
  IF(KISENDDISPL(IR)+KSENDCOUNTS(IR) > ISENDBUFSIZE) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_SCATTERV:SEND BUFFER TOO SMALL  ', &
     & IR,KISENDDISPL(IR),KSENDCOUNTS(IR),ISENDBUFSIZE
    CALL MPL_MESSAGE(CDMESSAGE='MPL_SCATTERV',CDSTRING=CDSTRING,LDABORT=LLABORT)
  ENDIF
ENDDO

END SUBROUTINE MPL_SCATTERV_PREAMB2

! ------------------------------------------------------------------
SUBROUTINE MPL_SCATTERV_REAL8(PRECVBUF,KROOT,PSENDBUF,KSENDCOUNTS,KSENDDISPL,&
 & KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_SCATTERV => MPI_SCATTERV8
#endif


REAL(KIND=JPRB), INTENT(OUT) :: PRECVBUF(:)
INTEGER(KIND=JPIM), INTENT(IN) :: KROOT
REAL(KIND=JPRB), INTENT(IN),OPTIONAL  :: PSENDBUF(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KSENDCOUNTS(:), KSENDDISPL(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ISENDDISPL(MPL_NUMPROC)

CALL MPL_SCATTERV_PREAMB1(KCOMM,KROOT)
IRECVCOUNT=SIZE(PRECVBUF)

IF(IPL_MYRANK == IROOT) THEN
  IF( .NOT. PRESENT(PSENDBUF)) CALL MPL_MESSAGE(&
   & CDMESSAGE='MPL_SCATTERV:SENDBUF MISSING',CDSTRING=CDSTRING,&
   & LDABORT=LLABORT)
  ISENDBUFSIZE=SIZE(PSENDBUF)
  CALL MPL_SCATTERV_PREAMB2(KSENDCOUNTS,ISENDDISPL,KSENDDISPL,CDSTRING)
  CALL MPI_SCATTERV(PSENDBUF,KSENDCOUNTS,ISENDDISPL,INT(MPI_REAL8), &
   & PRECVBUF,IRECVCOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)
ELSE
  CALL MPI_SCATTERV(ZDUM,1,1,INT(MPI_REAL8), &
   & PRECVBUF,IRECVCOUNT,INT(MPI_REAL8),IROOT-1,ICOMM,IERROR)
ENDIF  

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

END SUBROUTINE MPL_SCATTERV_REAL8

SUBROUTINE MPL_SCATTERV_INTEGER(KRECVBUF,KROOT,KSENDBUF,KSENDCOUNTS,&
 & KSENDDISPL,KCOMM,KERROR,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  Use mpi4to8, Only : &
    MPI_SCATTERV => MPI_SCATTERV8
#endif


INTEGER(KIND=JPIM), INTENT(OUT) :: KRECVBUF(:)
INTEGER(KIND=JPIM), INTENT(IN) :: KROOT
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KSENDBUF(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KSENDCOUNTS(:), KSENDDISPL(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: ISENDDISPL(MPL_NUMPROC)

CALL MPL_SCATTERV_PREAMB1(KCOMM,KROOT)
IRECVCOUNT=SIZE(KRECVBUF)

IF(IPL_MYRANK == IROOT) THEN
  IF( .NOT. PRESENT(KSENDBUF)) CALL MPL_MESSAGE(&
   & CDMESSAGE='MPL_SCATTERV:SENDBUF MISSING',CDSTRING=CDSTRING,&
   & LDABORT=LLABORT)
  ISENDBUFSIZE=SIZE(KSENDBUF)
  CALL MPL_SCATTERV_PREAMB2(KSENDCOUNTS,ISENDDISPL,KSENDDISPL,&
   & CDSTRING)
  CALL MPI_SCATTERV(KSENDBUF,KSENDCOUNTS,ISENDDISPL,INT(MPI_INTEGER), &
   & KRECVBUF,IRECVCOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR)
ELSE
  CALL MPI_SCATTERV(ZDUM_INT,1,1,INT(MPI_INTEGER), &
   & KRECVBUF,IRECVCOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR)
ENDIF  

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

END SUBROUTINE MPL_SCATTERV_INTEGER
! ------------------------------------------------------------------

END MODULE MPL_SCATTERV_MOD
