#ifdef RS6K
@PROCESS NOCHECK
#endif
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
!           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 :
!        -------------------------
!           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
!        Threadsafe: 2004-12-15  J.Hague

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

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

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_PREAMB(KRECVCOUNTS,KCOMM,KRECVDISPL,CDSTRING)


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


INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: IMAXMSG,JK,IMYPAIR,ICHUNKS,ISTS,ISTR,JMESS,ILENS,IENS,IOUNT
INTEGER(KIND=JPIM) :: ILIMIT,IBARRFREQ,IDUM
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE( &
  & CDMESSAGE='MPL_ALLGATHERV: 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
ELSE
  CALL MPI_COMM_SIZE(ICOMM,IPL_NUMPROC,IERROR)
ENDIF

IF(SIZE(KRECVCOUNTS)  < IPL_NUMPROC) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_ALLGATHERV: ERROR KRECVCOUNTS dimension=',&
   & SIZE(KRECVCOUNTS)
  CALL MPL_MESSAGE(CDMESSAGE=&
   & 'MPL_ALLGATHERV: ERROR KRECVCOUNTS dimension is wrong',LDABORT=LLABORT)
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

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

DEALLOCATE(IRECVDISPL)

END SUBROUTINE MPL_ALLGATHERV_PREAMB

SUBROUTINE MPL_ALLGATHERV_REAL4(PSENDBUF,PRECVBUF,KRECVCOUNTS,KRECVDISPL, &
                            & KCOMM,KERROR,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 :: KRECVDISPL(:),KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: IMAXMSG,JK,IMYPAIR,ICHUNKS,ISTS,ISTR,JMESS,ILENS,IENS,IOUNT
INTEGER(KIND=JPIM) :: ILIMIT,IBARRFREQ,IDUM
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
ISENDCOUNT = SIZE(PSENDBUF)
ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
IRECVCOUNT = SIZE(PRECVBUF)
#ifndef NAG

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

!--------- Preamble repeated for threadsafe--------------
! CALL MPL_ALLGATHERV_PREAMB(KRECVCOUNTS,KCOMM,KRECVDISPL,CDSTRING)
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
!--------- End of Preamble --------------

!Tournament table exchange

IF(ICOMM == MPL_COMM .AND. .NOT. LUSEHLMPI) THEN
  IERROR = 0
  PRECVBUF(IRECVDISPL(MPL_RANK)+1:IRECVDISPL(MPL_RANK)+KRECVCOUNTS(MPL_RANK)) = &
   & PSENDBUF(:)
  ILIMIT = 0.9*MPL_MBX_SIZE/4
  IMAXMSG = ILIMIT/2
  LLBARRIER = IRECVCOUNT>ILIMIT
  IBARRFREQ = MAX(1,ILIMIT/MAX(1,MAXVAL(KRECVCOUNTS))-1)
  CALL MPL_BARRIER(ICOMM,CDSTRING)
  DO JK=1,IPL_NUMPROC
    IMYPAIR = MPL_OPPONENT(JK)
    IF(JK > 1 .AND. LLBARRIER) THEN
      IF(MOD(JK,IBARRFREQ) == 0) THEN
        CALL MPL_BARRIER(ICOMM,CDSTRING)
      ENDIF
    ENDIF
    IF(IMYPAIR == MPL_RANK .OR. IMYPAIR > IPL_NUMPROC) THEN
      CYCLE
    ENDIF
    ICHUNKS = (MAX(ISENDCOUNT,KRECVCOUNTS(IMYPAIR))-1)/IMAXMSG+1
    ISTS = 1
    ISTR = IRECVDISPL(IMYPAIR)+1
    DO JMESS=1,ICHUNKS
      ITAG = 1900+JMESS
      ILENS = MIN(ISENDCOUNT-ISTS+1,IMAXMSG)
      IENS  = ISTS+ILENS-1
      IF(ILENS > 0) THEN
        CALL MPL_SEND(PSENDBUF(ISTS:IENS),KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        ISTS = ISTS+ILENS
      ELSE
        CALL MPL_SEND(IDUM,KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/SEND)',&
       & CDSTRING,LDABORT=LLABORT)
      IF(ISTR <= IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
        CALL MPL_RECV(PRECVBUF(ISTR:),KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(ISTR+IOUNT-1 > IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
          WRITE(MPL_ERRUNIT,'(A,5I10)')'WRONG  RECEIVE ', &
           & IMYPAIR,ISTR,IOUNT,IRECVDISPL(IMYPAIR),KRECVCOUNTS(IMYPAIR)
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
        ISTR = ISTR+IOUNT
      ELSE
        CALL MPL_RECV(IDUM,KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
        & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(IOUNT /= 1) THEN
          WRITE(MPL_ERRUNIT,'(A,4I10)')'WRONG DUMMY RECEIVE ', &
           & IMYPAIR,IOUNT
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/RECV)',&
       & CDSTRING,LDABORT=LLABORT)
    ENDDO
  ENDDO
ELSE

  IF(IPL_NUMPROC > 1) THEN
    CALL MPI_ALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL4),PRECVBUF(1),&
     & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL4),ICOMM,IERROR)
  ELSE
    PRECVBUF(1:ISENDCOUNT) = PSENDBUF(1:ISENDCOUNT)
    IERROR=0
  ENDIF
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,KRECVDISPL, &
                            & KCOMM,KERROR,CDSTRING)


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



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

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: IMAXMSG,JK,IMYPAIR,ICHUNKS,ISTS,ISTR,JMESS,ILENS,IENS,IOUNT
INTEGER(KIND=JPIM) :: ILIMIT,IBARRFREQ,IDUM
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID,J
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
ISENDCOUNT = SIZE(PSENDBUF)
ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
IRECVCOUNT = SIZE(PRECVBUF)
#ifndef NAG

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

!--------- Preamble repeated for threadsafe--------------
! CALL MPL_ALLGATHERV_PREAMB(KRECVCOUNTS,KCOMM,KRECVDISPL,CDSTRING)
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
!--------- End of Preamble --------------

!Tournament table exchange
IERROR=0
IF(ICOMM == MPL_COMM .AND. .NOT. LUSEHLMPI) THEN
  IERROR = 0
  PRECVBUF(IRECVDISPL(MPL_RANK)+1:IRECVDISPL(MPL_RANK)+KRECVCOUNTS(MPL_RANK)) = &
   & PSENDBUF(:)
  ILIMIT = 0.9*MPL_MBX_SIZE/8
  IMAXMSG = ILIMIT/2
  LLBARRIER = IRECVCOUNT>ILIMIT
  IBARRFREQ = MAX(1,ILIMIT/MAX(1,MAXVAL(KRECVCOUNTS))-1)
  CALL MPL_BARRIER(ICOMM,CDSTRING)
  DO JK=1,IPL_NUMPROC
    IMYPAIR = MPL_OPPONENT(JK)
    IF(JK > 1 .AND. LLBARRIER) THEN
      IF(MOD(JK,IBARRFREQ) == 0) THEN
        CALL MPL_BARRIER(ICOMM,CDSTRING)
      ENDIF
    ENDIF
    IF(IMYPAIR == MPL_RANK .OR. IMYPAIR > IPL_NUMPROC) THEN
      CYCLE
    ENDIF
    ICHUNKS = (MAX(ISENDCOUNT,KRECVCOUNTS(IMYPAIR))-1)/IMAXMSG+1
    ISTS = 1
    ISTR = IRECVDISPL(IMYPAIR)+1
    DO JMESS=1,ICHUNKS
      ITAG = 1900+JMESS
      ILENS = MIN(ISENDCOUNT-ISTS+1,IMAXMSG)
      IENS  = ISTS+ILENS-1
      IF(ILENS > 0) THEN
        CALL MPL_SEND(PSENDBUF(ISTS:IENS),KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        ISTS = ISTS+ILENS
      ELSE
        CALL MPL_SEND(IDUM,KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/SEND)',& 
       & CDSTRING,LDABORT=LLABORT)
      IF(ISTR <= IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
        CALL MPL_RECV(PRECVBUF(ISTR:),KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(ISTR+IOUNT-1 > IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
          WRITE(MPL_ERRUNIT,'(A,5I10)')'WRONG  RECEIVE ', &
           & IMYPAIR,ISTR,IOUNT,IRECVDISPL(IMYPAIR),KRECVCOUNTS(IMYPAIR)
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
        ISTR = ISTR+IOUNT
      ELSE
        CALL MPL_RECV(IDUM,KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
        & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(IOUNT /= 1) THEN
          WRITE(MPL_ERRUNIT,'(A,4I10)')'WRONG DUMMY RECEIVE ', &
           & IMYPAIR,IOUNT
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/RECV)',&
       & CDSTRING,LDABORT=LLABORT)
    ENDDO
  ENDDO
ELSE
  IF(IPL_NUMPROC > 1) THEN
    CALL MPI_ALLGATHERV(PSENDBUF(1),ISENDCOUNT,INT(MPI_REAL8),PRECVBUF(1),&
     & KRECVCOUNTS,IRECVDISPL,INT(MPI_REAL8),ICOMM,IERROR)
  ELSE
    PRECVBUF(1:ISENDCOUNT) = PSENDBUF(1:ISENDCOUNT)
    IERROR=0
  ENDIF
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,KRECVDISPL, &
                            & KCOMM,KERROR,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 :: KRECVDISPL(:),KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: IMAXMSG,JK,IMYPAIR,ICHUNKS,ISTS,ISTR,JMESS,ILENS,IENS,IOUNT
INTEGER(KIND=JPIM) :: ILIMIT,IBARRFREQ,IDUM
INTEGER(KIND=JPIM) :: ICOMM,IERROR,IPL_NUMPROC
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM),ALLOCATABLE :: IRECVDISPL(:)
ITID = OML_MY_THREAD()
ISENDCOUNT = SIZE(KSENDBUF)
ISENDCOUNT = MAX(0,ISENDCOUNT)  ! Bug? on IBM
IRECVCOUNT = SIZE(KRECVBUF)
#ifndef NAG

IF( (LOC(KSENDBUF(UBOUND(KSENDBUF,1))) - LOC(KSENDBUF(LBOUND(KSENDBUF,1)))) /= 4*(ISENDCOUNT - 1) .AND. &
  & ISENDCOUNT > 0 ) THEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLGATHERV: SENDBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
ENDIF
IF( (LOC(KRECVBUF(UBOUND(KRECVBUF,1))) - LOC(KRECVBUF(LBOUND(KRECVBUF,1)))) /= 4*(IRECVCOUNT - 1) .AND. &
  & IRECVCOUNT > 0 ) THEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLGATHERV: RECVBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
ENDIF
#endif

!--------- Preamble repeated for threadsafe--------------
! CALL MPL_ALLGATHERV_PREAMB(KRECVCOUNTS,KCOMM,KRECVDISPL,CDSTRING)
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
!--------- End of Preamble --------------

!Tournament table exchange
IERROR=0
IF(ICOMM == MPL_COMM .AND. .NOT. LUSEHLMPI) THEN
  IERROR = 0
  KRECVBUF(IRECVDISPL(MPL_RANK)+1:IRECVDISPL(MPL_RANK)+KRECVCOUNTS(MPL_RANK)) = &
   & KSENDBUF(:)

  ILIMIT = 0.9*MPL_MBX_SIZE/4
  IMAXMSG = ILIMIT/2
  LLBARRIER = IRECVCOUNT>ILIMIT
  IBARRFREQ = MAX(1,ILIMIT/MAX(1,MAXVAL(KRECVCOUNTS))-1)
  CALL MPL_BARRIER(ICOMM,CDSTRING)
  DO JK=1,IPL_NUMPROC
    IMYPAIR = MPL_OPPONENT(JK)
    IF(JK > 1 .AND. LLBARRIER) THEN
      IF(MOD(JK,IBARRFREQ) == 0) THEN
        CALL MPL_BARRIER(ICOMM,CDSTRING)
      ENDIF
    ENDIF
    IF(IMYPAIR == MPL_RANK .OR. IMYPAIR > IPL_NUMPROC) THEN
      CYCLE
    ENDIF
    ICHUNKS = (MAX(ISENDCOUNT,KRECVCOUNTS(IMYPAIR))-1)/IMAXMSG+1
    ISTS = 1
    ISTR = IRECVDISPL(IMYPAIR)+1
    DO JMESS=1,ICHUNKS
      ITAG = 1900+JMESS
      ILENS = MIN(ISENDCOUNT-ISTS+1,IMAXMSG)
      IENS  = ISTS+ILENS-1
      IF(ILENS > 0) THEN
        CALL MPL_SEND(KSENDBUF(ISTS:IENS),KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        ISTS = ISTS+ILENS
      ELSE
        CALL MPL_SEND(IDUM,KTAG=ITAG,KDEST=IMYPAIR,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/SEND)', &
       & CDSTRING,LDABORT=LLABORT)
      IF(ISTR <= IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
        CALL MPL_RECV(KRECVBUF(ISTR:),KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
         & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(ISTR+IOUNT-1 > IRECVDISPL(IMYPAIR)+KRECVCOUNTS(IMYPAIR)) THEN
          WRITE(MPL_ERRUNIT,'(A,5I10)')'WRONG  RECEIVE ', &
           & IMYPAIR,ISTR,IOUNT,IRECVDISPL(IMYPAIR),KRECVCOUNTS(IMYPAIR)
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
        ISTR = ISTR+IOUNT
      ELSE
        CALL MPL_RECV(IDUM,KTAG=ITAG,KSOURCE=IMYPAIR,KOUNT=IOUNT,&
        & KERROR=IERROR,CDSTRING=CDSTRING)
        IF(IOUNT /= 1) THEN
          WRITE(MPL_ERRUNIT,'(A,4I10)')'WRONG DUMMY RECEIVE ', &
           & IMYPAIR,IOUNT
          CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV',CDSTRING,LDABORT=LLABORT)
        ENDIF
      ENDIF
      IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_ALLGATHERV(TT/RECV)',&
       & CDSTRING,LDABORT=LLABORT)
    ENDDO
  ENDDO
ELSE
  IF(IPL_NUMPROC > 1) THEN
    CALL MPI_ALLGATHERV(KSENDBUF(1),ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),&
     & KRECVCOUNTS,IRECVDISPL,INT(MPI_INTEGER),ICOMM,IERROR)
  ELSE
    KRECVBUF(1:ISENDCOUNT) = KSENDBUF(1:ISENDCOUNT)
    IERROR=0
  ENDIF
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,KRECVDISPL, &
                            & KCOMM,KERROR,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(:) ! Not used; for compatibility only
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING

INTEGER(KIND=JPIM) :: IR,ISENDCOUNT,IRECVCOUNT
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: IMAXMSG,JK,IMYPAIR,ICHUNKS,ISTS,ISTR,JMESS,ILENS,IENS,IOUNT
INTEGER(KIND=JPIM) :: ILIMIT,IBARRFREQ,IDUM
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()
ISENDCOUNT = 1
IRECVCOUNT = SIZE(KRECVBUF)

IRECVCOUNTS(:) = 1
!--------- Preamble repeated for threadsafe--------------
! CALL MPL_ALLGATHERV_PREAMB(IRECVCOUNTS,KCOMM,KRECVDISPL,CDSTRING)
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
!--------- End of Preamble --------------

IF(IPL_NUMPROC > 1) THEN
  CALL MPI_ALLGATHERV(KSENDBUF,ISENDCOUNT,INT(MPI_INTEGER),KRECVBUF(1),IRECVCOUNTS,&
   &  IRECVDISPL,INT(MPI_INTEGER),ICOMM,IERROR)
ELSE
  KRECVBUF(1) = KSENDBUF
  IERROR=0
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
