p_allgatherv_i.F

Go to the documentation of this file.

!                   *************************
                    SUBROUTINE p_allgatherv_i
!                   *************************
!
     &(send_buffer, send_count, recv_buffer,
     & recv_count, displs, ierr)
!
!***********************************************************************
! PARALLEL   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    Gathers data from all tasks and deliver the combined data to all tasks
!
!warning  THIS ROUTINE MUST BE CALLED BY ALL THE NODES/PROCESSORS,
!+            OTHERWISE THE PROGRAM WILL "HANG"
!
!history  AUDOUIN YOANN
!+        25/04/2013
!+
!+   CREATED
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_parallel
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)    :: SEND_BUFFER(*)
      INTEGER, INTENT(IN)    :: SEND_COUNT
      INTEGER, INTENT(INOUT)   :: RECV_BUFFER(*)
      INTEGER, INTENT(IN)    :: RECV_COUNT(*)
      INTEGER, INTENT(IN)    :: DISPLS(*)
      INTEGER, INTENT(OUT)   :: IERR
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      ierr = 0
      recv_buffer(1) = 0
#if defined HAVE_MPI
      CALL mpi_allgatherv(send_buffer, send_count, mpi_integer,
     &                   recv_buffer, recv_count,
     &                   displs, mpi_integer, comm, ierr)
!
      IF(ierr.NE.0) THEN
        WRITE(lu,*) 'P_ALLGATHERV_I: ERROR IN MPI_BARRIER'
        WRITE(lu,*) 'MPI ERROR ',ierr
        CALL plante(1)
        stop
      ENDIF
      RETURN
#else
      WRITE(lu,*) 'CALL OF P_ALLGATHERV_I '//
     &                         'IN ITS VOID VERSION'
#endif
!
!-----------------------------------------------------------------------
!
      END