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

!**** MPL_ALLTOALLV - Everyone sends different data to everyone

!     Purpose.
!     --------
!     Interface to MPI_ALLTOALLV
 
!     The data may be REAL*8,or INTEGER

!**   Interface.
!     ----------
!        CALL MPL_ALLTOALLV

!        Input required arguments :
!        -------------------------
!           PSENDBUF -  buffer containing message
!                       (can be type  REAL*8 or INTEGER)
!           PRECVBUF -  buffer containing message
!                       (can be type REAL*8 or INTEGER)
!           KRECVCOUNTS-number of elements received from each process
!           KSENDCOUNTS-number of elements to be sent to 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
!           KRECVDISPL -displacements in PRECVBUF at which to place 
!                       the incoming data
!           KSENDDISPL -displacements in PSENDBUF from which to send
!                       the data
!           KMP_TYPE -  buffering type (see MPL_BUFFER_METHOD)
!                       overrides value provided to MPL_BUFFER_METHOD
!           CDSTRING -  Character string for ABORT messages
!                       used when KERROR is not provided

!        Output optional arguments :
!        -------------------------
!           KREQUEST -  Communication request
!                       required when buffering type is non-blocking
!           KERROR   -  return error code.     If not supplied, 
!                       MPL_ALLTOALLV aborts when an error is detected.

!     Author.
!     -------
!       Y. Tremolet

!     Modifications.
!     --------------
!       Original: 02-03-21
!       Modified : 25-09-02 M.Hamrud - generalize
!      F. Vana  05-Mar-2015  Support for single precision
! ------------------------------------------------------------------

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

USE MPL_MPIF
USE MPL_DATA_MODULE
USE MPL_MESSAGE_MOD
USE MPL_STATS_MOD
USE YOMMPLSTATS

IMPLICIT NONE
PRIVATE

LOGICAL :: LLABORT=.TRUE.
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC,IRECVCOUNT,ISENDCOUNT,IR,IMP_TYPE
LOGICAL :: LLSCALAR

INTERFACE MPL_ALLTOALLV
MODULE PROCEDURE MPL_ALLTOALLV_REAL8,MPL_ALLTOALLV_INTEGER,MPL_ALLTOALLV_REAL4
END INTERFACE

PUBLIC MPL_ALLTOALLV

CONTAINS
! ------------------------------------------------------------------

SUBROUTINE MPL_ALLTOALLV_PREAMB(KSENDCOUNTS,KISENDDISPL,&
 & KRECVCOUNTS,KIRECVDISPL,KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,CDSTRING)


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


INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:),KSENDCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KISENDDISPL(:),KIRECVDISPL(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KSENDDISPL(:),KRECVDISPL(:),KCOMM,KMP_TYPE
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING
INTEGER(KIND=JPIM) :: ITID,J
ITID = OML_MY_THREAD()
IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_ALLTOALLV: MPL NOT INITIALISED ',LDABORT=LLABORT)
 
IF(PRESENT(KCOMM)) THEN
  ICOMM=KCOMM
ELSE
  ICOMM=MPL_COMM_OML(ITID)
ENDIF

IF(PRESENT(KMP_TYPE)) THEN
  IMP_TYPE=KMP_TYPE
ELSE
  IMP_TYPE=MPL_METHOD
ENDIF

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

IF(SIZE(KRECVCOUNTS)  < IPL_NUMPROC) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_ALLTOALLV: ERROR KRECVCOUNTS dimension=',&
   & SIZE(KRECVCOUNTS)
  CALL MPL_MESSAGE(CDMESSAGE=&
   & 'MPL_ALLTOALLV: ERROR KRECVCOUNTS dimension is wrong',LDABORT=LLABORT)
ENDIF

IF(SIZE(KSENDCOUNTS)  < IPL_NUMPROC) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_ALLTOALLV: ERROR KSENDCOUNTS dimension=',&
   & SIZE(KSENDCOUNTS)
  CALL MPL_MESSAGE(CDMESSAGE=&
   & 'MPL_ALLTOALLV: ERROR KSENDCOUNTS dimension is wrong',LDABORT=LLABORT)
ENDIF

IF(PRESENT(KRECVDISPL)) THEN
  DO J=1,MIN(SIZE(KRECVDISPL),SIZE(KIRECVDISPL))
    KIRECVDISPL(J) = KRECVDISPL(J)
  ENDDO
ELSE
  KIRECVDISPL(:) = 0
  IF(LLSCALAR) THEN
    DO IR=2, IPL_NUMPROC
      KIRECVDISPL(IR) = KIRECVDISPL(IR-1) + 1
    ENDDO
  ELSE
    DO IR=2, IPL_NUMPROC
      KIRECVDISPL(IR) = KIRECVDISPL(IR-1) + KRECVCOUNTS(IR-1)
    ENDDO
  ENDIF
ENDIF

DO IR=1, IPL_NUMPROC
  IF(KIRECVDISPL(IR) < 0 .OR. KRECVCOUNTS(IR) < 0) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_ALLTOALLV: RECV.. < 0 ',&
     & IR,KIRECVDISPL(IR),KRECVCOUNTS(IR)
    CALL MPL_MESSAGE(IERROR,'MPL_ALLTOALLV',CDSTRING,LDABORT=LLABORT)
  ENDIF
  IF(KIRECVDISPL(IR)+KRECVCOUNTS(IR) > IRECVCOUNT) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_ALLTOALLV:RECV BUFFER TOO SMALL  ', &
     & IR,KIRECVDISPL(IR),KRECVCOUNTS(IR),IRECVCOUNT
    CALL MPL_MESSAGE(IERROR,'MPL_ALLTOALLV',CDSTRING,LDABORT=LLABORT)
  ENDIF
ENDDO

IF(PRESENT(KSENDDISPL)) THEN
  DO J=1,MIN(SIZE(KSENDDISPL),SIZE(KISENDDISPL))
    KISENDDISPL(J) = KSENDDISPL(J)
  ENDDO
ELSE
  KISENDDISPL(:) = 0
  IF(LLSCALAR) THEN
    DO IR=2, IPL_NUMPROC
      KISENDDISPL(IR) = KISENDDISPL(IR-1) + 1
    ENDDO
  ELSE
    DO IR=2, IPL_NUMPROC
      KISENDDISPL(IR) = KISENDDISPL(IR-1) + KSENDCOUNTS(IR-1)
    ENDDO
  ENDIF
ENDIF
DO IR=1, IPL_NUMPROC
  IF(KISENDDISPL(IR) < 0 .OR. KSENDCOUNTS(IR) < 0) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_ALLTOALLV:SEND.. <0 ',&
     & IR,KISENDDISPL(IR),KSENDCOUNTS(IR)
    CALL MPL_MESSAGE(IERROR,'MPL_ALLTOALLV',CDSTRING,LDABORT=LLABORT)
  ENDIF
  IF(KISENDDISPL(IR)+KSENDCOUNTS(IR) > ISENDCOUNT) THEN
    WRITE(MPL_ERRUNIT,'(A,4I10)')'MPL_ALLTOALLV:SEND BUFFER TOO SMALL  ', &
     & IR,KISENDDISPL(IR),KSENDCOUNTS(IR),ISENDCOUNT
    CALL MPL_MESSAGE(IERROR,'MPL_ALLTOALLV',CDSTRING,LDABORT=LLABORT)
  ENDIF
ENDDO

END SUBROUTINE MPL_ALLTOALLV_PREAMB

SUBROUTINE MPL_ALLTOALLV_REAL8(PSENDBUF,KSENDCOUNTS,PRECVBUF,KRECVCOUNTS,&
 &KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_ALLTOALLV => MPI_ALLTOALLV8
#endif


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

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

ISENDCOUNT=SIZE(PSENDBUF)
IRECVCOUNT=SIZE(PRECVBUF)

#ifndef NAG
IF (ISENDCOUNT > 0) THEN
  IF( (LOC(PSENDBUF(UBOUND(PSENDBUF,1))) - LOC(PSENDBUF(LBOUND(PSENDBUF,1)))) /= 8_JPIB*(ISENDCOUNT - 1) .AND. &
    & ISENDCOUNT > 0 ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: SENDBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF

IF (IRECVCOUNT > 0) THEN
  IF( (LOC(PRECVBUF(UBOUND(PRECVBUF,1))) - LOC(PRECVBUF(LBOUND(PRECVBUF,1)))) /= 8_JPIB*(IRECVCOUNT - 1) .AND. &
    & IRECVCOUNT > 0 ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: RECVBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF
#endif

LLSCALAR=.FALSE.

IERROR=0
CALL MPL_ALLTOALLV_PREAMB(KSENDCOUNTS,ISENDDISPL,&
 & KRECVCOUNTS,IRECVDISPL,KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,CDSTRING)
IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLTOALLV(PSENDBUF(:),KSENDCOUNTS,ISENDDISPL,INT(MPI_REAL8), &
   & PRECVBUF(:),KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL8),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  IF(.NOT.PRESENT(KREQUEST)) CALL MPL_MESSAGE(KERROR,'MPL_ALLTOALLV',' KREQUEST MISSING',LDABORT=LLABORT)
  CALL MPI_IALLTOALLV(PSENDBUF(:),KSENDCOUNTS,ISENDDISPL,INT(MPI_REAL8), &
   & PRECVBUF(:),KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL8),ICOMM,KREQUEST,IERROR)
ELSE
  IF(PRESENT(KERROR)) THEN
    IERROR=1
  ELSE
    CALL MPL_MESSAGE(KERROR,'MPL_ALLTOALLV',' INVALID METHOD',LDABORT=LLABORT)
  ENDIF
ENDIF

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF (IERROR/=0) CALL MPL_MESSAGE(IERROR,'ERROR IN MPL_ALLTOALLV',&
   &LDABORT=LLABORT)
ENDIF

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

END SUBROUTINE MPL_ALLTOALLV_REAL8

SUBROUTINE MPL_ALLTOALLV_REAL4(PSENDBUF,KSENDCOUNTS,PRECVBUF,KRECVCOUNTS,&
 &KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_ALLTOALLV => MPI_ALLTOALLV8
#endif


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

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

ISENDCOUNT=SIZE(PSENDBUF)
IRECVCOUNT=SIZE(PRECVBUF)

#ifndef NAG
IF (ISENDCOUNT > 0) THEN
  IF( (LOC(PSENDBUF(UBOUND(PSENDBUF,1))) - LOC(PSENDBUF(LBOUND(PSENDBUF,1)))) /= 4_JPIB*(ISENDCOUNT - 1) ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: SENDBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF

IF (IRECVCOUNT > 0) THEN
  IF( (LOC(PRECVBUF(UBOUND(PRECVBUF,1))) - LOC(PRECVBUF(LBOUND(PRECVBUF,1)))) /= 4_JPIB*(IRECVCOUNT - 1) ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: RECVBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF
#endif

LLSCALAR=.FALSE.

IERROR=0
CALL MPL_ALLTOALLV_PREAMB(KSENDCOUNTS,ISENDDISPL,&
 & KRECVCOUNTS,IRECVDISPL,KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,CDSTRING)
IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLTOALLV(PSENDBUF(:),KSENDCOUNTS,ISENDDISPL,INT(MPI_REAL4), &
   & PRECVBUF(:),KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL4),ICOMM,IERROR)
ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
  CALL MPI_IALLTOALLV(PSENDBUF(:),KSENDCOUNTS,ISENDDISPL,INT(MPI_REAL4), &
   & PRECVBUF(:),KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL4),ICOMM,KREQUEST,IERROR)
ELSE
  IF(PRESENT(KERROR)) THEN
    IERROR=1
  ELSE
    CALL MPL_MESSAGE(KERROR,'MPL_ALLTOALLV',' INVALID METHOD',LDABORT=LLABORT)
  ENDIF
ENDIF

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF (IERROR/=0) CALL MPL_MESSAGE(IERROR,'ERROR IN MPL_ALLTOALLV',&
   &LDABORT=LLABORT)
ENDIF

IF(LMPLSTATS) THEN
  CALL MPL_SENDSTATS(SUM(KSENDCOUNTS),INT(MPI_REAL4))
  CALL MPL_RECVSTATS(SUM(KRECVCOUNTS),INT(MPI_REAL4))
ENDIF

END SUBROUTINE MPL_ALLTOALLV_REAL4


SUBROUTINE MPL_ALLTOALLV_INTEGER(KSENDBUF,KSENDCOUNTS,KRECVBUF,KRECVCOUNTS,&
 &KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)


#ifdef USE_8_BYTE_WORDS
  USE MPI4TO8, ONLY : &
    MPI_ALLTOALLV => MPI_ALLTOALLV8
#endif


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

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

ISENDCOUNT=SIZE(KSENDBUF)
IRECVCOUNT=SIZE(KRECVBUF)

#ifndef NAG
IF (ISENDCOUNT > 0) THEN
  IF( (LOC(KSENDBUF(UBOUND(KSENDBUF,1))) - LOC(KSENDBUF(LBOUND(KSENDBUF,1)))) /= 4_JPIB*(ISENDCOUNT - 1) ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: SENDBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF

IF (IRECVCOUNT > 0) THEN
  IF( (LOC(KRECVBUF(UBOUND(KRECVBUF,1))) - LOC(KRECVBUF(LBOUND(KRECVBUF,1)))) /= 4_JPIB*(IRECVCOUNT - 1) ) THEN
    CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLTOALLV: RECVBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
  ENDIF
ENDIF
#endif

LLSCALAR=.FALSE.

IERROR=0
CALL MPL_ALLTOALLV_PREAMB(KSENDCOUNTS,ISENDDISPL,&
 & KRECVCOUNTS,IRECVDISPL,KSENDDISPL,KRECVDISPL,KMP_TYPE,KCOMM,CDSTRING)
IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
  CALL MPI_ALLTOALLV(KSENDBUF(1),KSENDCOUNTS,ISENDDISPL,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
  IF(.NOT.PRESENT(KREQUEST)) CALL MPL_MESSAGE(KERROR,'MPL_ALLTOALLV',' KREQUEST MISSING',LDABORT=LLABORT)
  CALL MPI_IALLTOALLV(KSENDBUF(1),KSENDCOUNTS,ISENDDISPL,INT(MPI_INTEGER), &
   & KRECVBUF(1),KRECVCOUNTS,IRECVDISPL,INT(MPI_INTEGER),ICOMM,KREQUEST,IERROR)
ELSE
  IF(PRESENT(KERROR)) THEN
    IERROR=1
  ELSE
    CALL MPL_MESSAGE(KERROR,'MPL_ALLTOALLV',' INVALID METHOD',LDABORT=LLABORT)
  ENDIF
ENDIF

IF(PRESENT(KERROR)) THEN
  KERROR=IERROR
ELSE
  IF (IERROR/=0) CALL MPL_MESSAGE(IERROR,'ERROR IN MPL_ALLTOALLV',&
   &LDABORT=LLABORT)
ENDIF

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

END SUBROUTINE MPL_ALLTOALLV_INTEGER

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

END MODULE MPL_ALLTOALLV_MOD


