! (C) Copyright 2005- ECMWF.
! (C) Copyright 2013- Meteo-France.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

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
!           KMP_TYPE -  buffering type (see MPL_BUFFER_METHOD)
!                       overrides value provided to MPL_BUFFER_METHOD
!           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 :
!        -------------------------
!           KREQUEST -  Communication request
!                       required when buffering type is non-blocking
!           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
!        M.Hamrud     : 2014-10-22 : Add nonblocking option
!      F. Vana  05-Mar-2015  Support for single precision

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

!     ----------------------------------------------------------------
USE EC_PARKIND, ONLY : JPRD, JPIM, JPRM
USE OML_MOD,    ONLY : OML_MY_THREAD

USE MPL_MPI,                  ONLY : MPI_COMM, MPI_DATATYPE, MPI_REQUEST, MPI_REAL4, MPI_REAL8, MPI_INTEGER
USE MPL_DATA_MODULE,          ONLY : MPL_RANK, MPL_COMM_OML, MPL_ERRUNIT, MPL_NUMPROC, MPL_METHOD, &
 &                                   JP_BLOCKING_STANDARD, JP_BLOCKING_BUFFERED, &
 &                                   JP_NON_BLOCKING_STANDARD, JP_NON_BLOCKING_BUFFERED
USE MPL_MESSAGE_MOD,          ONLY : MPL_MESSAGE
USE MPL_STATS_MOD,            ONLY : MPL_RECVSTATS, MPL_SENDSTATS
USE YOMMPLSTATS,              ONLY : LMPLSTATS
USE MPL_MYRANK_MOD,           ONLY : MPL_MYRANK
USE MPL_DISPLS_CONTAINER_MOD, ONLY : YDDISPLS_LIST

IMPLICIT NONE
PRIVATE
PUBLIC MPL_SCATTERV

TYPE(MPI_COMM)     :: ICOMM
INTEGER(KIND=JPIM) :: IROOT,IPL_NUMPROC,IRECVCOUNT,ISENDBUFSIZE,IR,IPL_MYRANK,IMP_TYPE
LOGICAL            :: LLABORT=.TRUE.
INTEGER(KIND=JPIM) :: IERROR,IDUM
REAL(KIND=JPRD)    :: ZDUM
REAL(KIND=JPRM)    :: ZDUM_4
INTEGER(KIND=JPIM)    :: ZDUM_INT
INTEGER(KIND=JPIM), ALLOCATABLE :: ONES(:)

INTERFACE MPL_SCATTERV
  MODULE PROCEDURE MPL_SCATTERV_REAL8,MPL_SCATTERV_REAL4,MPL_SCATTERV_INTEGER
END INTERFACE

CONTAINS

SUBROUTINE MPL_SCATTERV_PREAMB1(KCOMM,KROOT,KMP_TYPE,KREQUEST)

#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),INTENT(IN),OPTIONAL :: KMP_TYPE
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KREQUEST
INTEGER(KIND=JPIM) :: ITID,ICOMM_SIZE,IERR
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%MPI_VAL=KCOMM
ELSE
  ICOMM%MPI_VAL=MPL_COMM_OML(ITID)
ENDIF
CALL MPI_COMM_SIZE(ICOMM, ICOMM_SIZE, IERR)
IF (IERR /= 0) THEN
  CALL ABOR1('PROBLEM WITH SIZE OF ICOMM IN MPL_SCATTERV_PREAMB1')
ELSE
  IF (.NOT. ALLOCATED(ONES)) THEN
    ALLOCATE(ONES(ICOMM_SIZE))
    ONES(:) = 1_JPIM
  ENDIF
ENDIF

IF(PRESENT(KMP_TYPE)) THEN
  IMP_TYPE=KMP_TYPE
ELSE
  IMP_TYPE=MPL_METHOD
ENDIF
IF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  IF(.NOT.PRESENT(KREQUEST)) CALL MPL_MESSAGE(CDMESSAGE='MPL_SCATTERV:  KREQUEST MISSING',LDABORT=LLABORT)
ENDIF

IF(ICOMM%MPI_VAL == 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%MPI_VAL)
ENDIF

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

END SUBROUTINE MPL_SCATTERV_PREAMB1

SUBROUTINE MPL_SCATTERV_PREAMB2(KSENDCOUNTS,KISENDDISPL,KSENDDISPL,KISENDDISPL_PT,CDSTRING)

INTEGER(KIND=JPIM),INTENT(IN) :: KSENDCOUNTS(:)
INTEGER(KIND=JPIM),TARGET,INTENT(IN),OPTIONAL :: KSENDDISPL(:)
INTEGER(KIND=JPIM),ALLOCATABLE,TARGET,INTENT(OUT) :: KISENDDISPL(:)
INTEGER(KIND=JPIM),POINTER,INTENT(OUT),OPTIONAL :: KISENDDISPL_PT(:)
CHARACTER(LEN=*),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_PT => KSENDDISPL(:)
ELSE
  IF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
    CALL YDDISPLS_LIST%APPEND(KNPROC=IPL_NUMPROC,KRECV_PT=KISENDDISPL_PT)
  ELSE
    ALLOCATE(KISENDDISPL(IPL_NUMPROC))
    KISENDDISPL_PT => KISENDDISPL
  END IF
  KISENDDISPL_PT(1) = 0
  DO IR=2, IPL_NUMPROC
    KISENDDISPL_PT(IR) = KISENDDISPL_PT(IR-1) + KSENDCOUNTS(IR-1)
  ENDDO
ENDIF
DO IR=1, IPL_NUMPROC
  IF(KISENDDISPL_PT(IR)+KSENDCOUNTS(IR) > ISENDBUFSIZE) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_SCATTERV:SEND BUFFER TOO SMALL  ', &
      & IR,KISENDDISPL_PT(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,&
  & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
USE MPI4TO8, ONLY : &
  MPI_SCATTERV => MPI_SCATTERV8
#endif


REAL(KIND=JPRD), INTENT(OUT) :: PRECVBUF(:)
INTEGER(KIND=JPIM), INTENT(IN) :: KROOT
REAL(KIND=JPRD), INTENT(IN),OPTIONAL  :: PSENDBUF(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KSENDCOUNTS(:)
INTEGER(KIND=JPIM), INTENT(IN),TARGET,OPTIONAL :: KSENDDISPL(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM),ALLOCATABLE :: ISENDDISPL(:)
INTEGER(KIND=JPIM),POINTER :: ISENDDISPL_PT(:)
TYPE(MPI_DATATYPE) :: IDATA_TYPE
LOGICAL            :: LLPRESENT_SENDBUF
TYPE(MPI_REQUEST)  :: IREQUEST_LOCAL

IDATA_TYPE=MPI_REAL8
LLPRESENT_SENDBUF=PRESENT(PSENDBUF)

#include "mpl_scatterv_array_tmpl.i90"

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

#ifdef USE_8_BYTE_WORDS
USE MPI4TO8, ONLY : &
  MPI_SCATTERV => MPI_SCATTERV8
#endif

REAL(KIND=JPRM), INTENT(OUT) :: PRECVBUF(:)
INTEGER(KIND=JPIM), INTENT(IN) :: KROOT
REAL(KIND=JPRM), INTENT(IN),OPTIONAL  :: PSENDBUF(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KSENDCOUNTS(:)
INTEGER(KIND=JPIM), INTENT(IN),TARGET,OPTIONAL :: KSENDDISPL(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM),ALLOCATABLE :: ISENDDISPL(:)
INTEGER(KIND=JPIM),POINTER :: ISENDDISPL_PT(:)
TYPE(MPI_DATATYPE) :: IDATA_TYPE
LOGICAL            :: LLPRESENT_SENDBUF
TYPE(MPI_REQUEST)  :: IREQUEST_LOCAL

IDATA_TYPE=MPI_REAL4
LLPRESENT_SENDBUF=PRESENT(PSENDBUF)

#include "mpl_scatterv_array_tmpl.i90"

END SUBROUTINE MPL_SCATTERV_REAL4


SUBROUTINE MPL_SCATTERV_INTEGER(KRECVBUF,KROOT,KSENDBUF,KSENDCOUNTS,&
  & KSENDDISPL,KMP_TYPE,KCOMM,KERROR,KREQUEST,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(:)
INTEGER(KIND=JPIM), INTENT(IN),TARGET,OPTIONAL :: KSENDDISPL(:)
INTEGER(KIND=JPIM), INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM),ALLOCATABLE :: ISENDDISPL(:)
INTEGER(KIND=JPIM),POINTER :: ISENDDISPL_PT(:)
TYPE(MPI_DATATYPE) :: IDATA_TYPE
LOGICAL            :: LLPRESENT_SENDBUF
TYPE(MPI_REQUEST)  :: IREQUEST_LOCAL

IDATA_TYPE=MPI_INTEGER
LLPRESENT_SENDBUF=PRESENT(KSENDBUF)

IF (PRESENT(KSENDBUF)) THEN
ASSOCIATE(PRECVBUF=>KRECVBUF, PSENDBUF=>KSENDBUF)
#include "mpl_scatterv_array_tmpl.i90"
END ASSOCIATE
ELSE
ASSOCIATE(PRECVBUF=>KRECVBUF, PSENDBUF=>KRECVBUF)
#include "mpl_scatterv_array_tmpl.i90"
END ASSOCIATE
END IF

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

END MODULE MPL_SCATTERV_MOD
