! (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_ALLGATHERV_MOD

!**** MPL_ALLGATHERV Send data to all processes

!     Purpose.
!     --------
!     Send a message to all processes from a buffer.
!     The data may be REAL*4, REAL*8,or INTEGER, one dimensional array
!                     REAL*4,or REAL*8, two dimensional array
!                  or INTEGER scalar

!**   Interface.
!     ----------
!        CALL MPL_ALLGATHERV

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

!        Input optional arguments :
!        -------------------------
!           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
!           KRECVDISPL -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_ALLGATHERV aborts when an error is detected.
!     Author.
!     -------
!        D.Dent, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original:   2000-11-23
!        J.Hague:    2004-12-15 : Threadsafe
!        M.Hamrud:   2014-10-22 : Add nonblocking option
!        F.Vana:     2015-03-05 : Support for single precision
!        P.Gillies:  2018-05-30 : Add KSENDCOUNT argument, needed for zero length sends

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

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

USE MPL_MPIF
USE MPL_DATA_MODULE
USE MPL_STATS_MOD
USE YOMMPLSTATS
USE MPL_MESSAGE_MOD
USE MPL_SEND_MOD
USE MPL_RECV_MOD
USE MPL_BARRIER_MOD

IMPLICIT NONE

PRIVATE

LOGICAL   :: LLABORT=.TRUE.
LOGICAL   :: LLBARRIER

INTERFACE MPL_ALLGATHERV
MODULE PROCEDURE MPL_ALLGATHERV_REAL8,MPL_ALLGATHERV_REAL4,&
                 MPL_ALLGATHERV_INT,  MPL_ALLGATHERV_INT_SCALAR
END INTERFACE

PUBLIC MPL_ALLGATHERV

CONTAINS


SUBROUTINE MPL_ALLGATHERV_REAL4(PSENDBUF,PRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
                            & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_ALLGATHERV => MPI_ALLGATHERV8
#endif



REAL(KIND=JPRM)            :: PSENDBUF(:)
REAL(KIND=JPRM)            :: PRECVBUF(:)
INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KSENDCOUNT
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: IMP_TYPE
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)

ITID = OML_MY_THREAD()
IF(PRESENT(KSENDCOUNT)) THEN
  ISENDCOUNT = KSENDCOUNT
ELSE
  ISENDCOUNT = SIZE(PSENDBUF)
  ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
ENDIF
IRECVCOUNT = SIZE(PRECVBUF)

!--------- Preamble repeated for threadsafe--------------
IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

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

ALLOCATE(IRECVDISPL(IPL_NUMPROC))
IF(PRESENT(KRECVDISPL)) THEN
  IRECVDISPL(:) = KRECVDISPL(:)
ELSE
  IRECVDISPL(:) = 0
  DO IR=2, IPL_NUMPROC
    IRECVDISPL(IR) = IRECVDISPL(IR-1) + KRECVCOUNTS(IR-1)
  ENDDO
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_ALLGATHERV:  KREQUEST MISSING',LDABORT=LLABORT)
ENDIF
!--------- End of Preamble --------------


IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL4),PRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL4),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  CALL MPI_IALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL4),PRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL4),ICOMM,KREQUEST,IERROR)
ENDIF
IF(LMPLSTATS) THEN
  CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_REAL4))
  CALL MPL_RECVSTATS(SUM(KRECVCOUNTS),INT(MPI_REAL4))
ENDIF

IF(MPL_OUTPUT > 1 )THEN
  WRITE(MPL_UNIT,'(A,5I8)') ' MPL_ALLGATHERV ',ISENDCOUNT,IRECVCOUNT,ICOMM
ENDIF
IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',&
   & CDSTRING,LDABORT=LLABORT)
ENDIF
DEALLOCATE(IRECVDISPL)

END SUBROUTINE MPL_ALLGATHERV_REAL4

SUBROUTINE MPL_ALLGATHERV_REAL8(PSENDBUF,PRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
                            & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_ALLGATHERV => MPI_ALLGATHERV8
#endif



REAL(KIND=JPRD)            :: PSENDBUF(:)
REAL(KIND=JPRD)            :: PRECVBUF(:)
INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KSENDCOUNT
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: IMP_TYPE
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID,J
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
IF(PRESENT(KSENDCOUNT)) THEN
  ISENDCOUNT = KSENDCOUNT
ELSE
  ISENDCOUNT = SIZE(PSENDBUF)
  ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
ENDIF
IRECVCOUNT = SIZE(PRECVBUF)

!--------- Preamble repeated for threadsafe--------------
IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

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

ALLOCATE(IRECVDISPL(IPL_NUMPROC))
IF(PRESENT(KRECVDISPL)) THEN
  DO J=1,MIN(SIZE(IRECVDISPL),SIZE(KRECVDISPL))
    IRECVDISPL(J) = KRECVDISPL(J)
  ENDDO
ELSE
  IRECVDISPL(:) = 0
  DO IR=2, IPL_NUMPROC
    IRECVDISPL(IR) = IRECVDISPL(IR-1) + KRECVCOUNTS(IR-1)
  ENDDO
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_ALLGATHERV:  KREQUEST MISSING',LDABORT=LLABORT)
ENDIF
!!--------- End of Preamble --------------

IERROR=0

IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL8),PRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL8),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  CALL MPI_IALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL8),PRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL8),ICOMM,KREQUEST,IERROR)
ENDIF

IF(LMPLSTATS) THEN
  CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_REAL8))
  CALL MPL_RECVSTATS(SUM(KRECVCOUNTS),INT(MPI_REAL8))
ENDIF

IF(MPL_OUTPUT > 1 )THEN
  WRITE(MPL_UNIT,'(A,5I8)') ' MPL_ALLGATHERV ',ISENDCOUNT,IRECVCOUNT,ICOMM
ENDIF
IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,&
   & LDABORT=LLABORT)
ENDIF
DEALLOCATE(IRECVDISPL)

END SUBROUTINE MPL_ALLGATHERV_REAL8

SUBROUTINE MPL_ALLGATHERV_INT(KSENDBUF,KRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
                            & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_ALLGATHERV => MPI_ALLGATHERV8
#endif



INTEGER(KIND=JPIM)         :: KSENDBUF(:)
INTEGER(KIND=JPIM)         :: KRECVBUF(:)
INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN), OPTIONAL :: KSENDCOUNT
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: IMP_TYPE
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
IF(PRESENT(KSENDCOUNT)) THEN
  ISENDCOUNT = KSENDCOUNT
ELSE
  ISENDCOUNT = SIZE(KSENDBUF)
  ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
ENDIF
IRECVCOUNT = SIZE(KRECVBUF)

!--------- Preamble repeated for threadsafe--------------
IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

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

ALLOCATE(IRECVDISPL(IPL_NUMPROC))
IF(PRESENT(KRECVDISPL)) THEN
  IRECVDISPL(:) = KRECVDISPL(:)
ELSE
  IRECVDISPL(:) = 0
  DO IR=2, IPL_NUMPROC
    IRECVDISPL(IR) = IRECVDISPL(IR-1) + KRECVCOUNTS(IR-1)
  ENDDO
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_ALLGATHERV:  KREQUEST MISSING',LDABORT=LLABORT)
ENDIF
!--------- End of Preamble --------------

IERROR=0
IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLGATHERV(KSENDBUF(1),ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_INTEGER),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  CALL MPI_IALLGATHERV(KSENDBUF(1),ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),&
   & KRECVCOUNTS,IRECVDISPL,INT(MPI_INTEGER),ICOMM,KREQUEST,IERROR)
ENDIF

IF(LMPLSTATS) THEN
  CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_INTEGER))
  CALL MPL_RECVSTATS(SUM(KRECVCOUNTS),INT(MPI_INTEGER))
ENDIF

IF(MPL_OUTPUT > 1 )THEN
  WRITE(MPL_UNIT,'(A,5I8)') ' MPL_ALLGATHERV ',ISENDCOUNT,IRECVCOUNT,ICOMM
ENDIF
IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
ENDIF
DEALLOCATE(IRECVDISPL)

END SUBROUTINE MPL_ALLGATHERV_INT

SUBROUTINE MPL_ALLGATHERV_INT_SCALAR(KSENDBUF,KRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
                            & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_ALLGATHERV => MPI_ALLGATHERV8
#endif



INTEGER(KIND=JPIM)         :: KSENDBUF
INTEGER(KIND=JPIM)         :: KRECVBUF(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN), OPTIONAL :: KSENDCOUNT
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: IMP_TYPE
INTEGER(KIND=JPIM) :: IRECVCOUNTS(MPL_NUMPROC)
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
IF(PRESENT(KSENDCOUNT)) THEN
  ISENDCOUNT = KSENDCOUNT
ELSE
  ISENDCOUNT = 1
ENDIF
IRECVCOUNT = SIZE(KRECVBUF)
IF(PRESENT(KRECVCOUNTS)) THEN
  IRECVCOUNTS=KRECVCOUNTS
ELSE
  IRECVCOUNTS(:) = 1
ENDIF
!IF(PRESENT(KSENDCOUNT)) WRITE(*,*) 'ALLGATHERV_SCALAR', IRECVCOUNTS
!--------- Preamble repeated for threadsafe--------------
IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

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

ALLOCATE(IRECVDISPL(IPL_NUMPROC))
IF(PRESENT(KRECVDISPL)) THEN
  IRECVDISPL(:) = KRECVDISPL(:)
ELSE
  IRECVDISPL(:) = 0
  DO IR=2, IPL_NUMPROC
    IRECVDISPL(IR) = IRECVDISPL(IR-1) + IRECVCOUNTS(IR-1)
  ENDDO
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_ALLGATHERV:  KREQUEST MISSING',LDABORT=LLABORT)
ENDIF
!--------- End of Preamble --------------

IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLGATHERV(KSENDBUF,ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),IRECVCOUNTS,&
   &  IRECVDISPL,INT(MPI_INTEGER),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  CALL MPI_IALLGATHERV(KSENDBUF,ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),IRECVCOUNTS,&
   &  IRECVDISPL,INT(MPI_INTEGER),ICOMM,KREQUEST,IERROR)
ENDIF
IF(LMPLSTATS) THEN
  CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_INTEGER))
  CALL MPL_RECVSTATS(SUM(IRECVCOUNTS),INT(MPI_INTEGER))
ENDIF

IF(MPL_OUTPUT > 1 )THEN
  WRITE(MPL_UNIT,'(A,5I8)') ' MPL_ALLGATHERV ',ISENDCOUNT,IRECVCOUNT,ICOMM
ENDIF
IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
ENDIF
DEALLOCATE(IRECVDISPL)

END SUBROUTINE MPL_ALLGATHERV_INT_SCALAR

END MODULE MPL_ALLGATHERV_MOD
