p_lsum.F

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE p_lsum
!                   *****************
!
     &(buffer_length,lbuffer)
!
!***********************************************************************
! PARALLEL   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    REDUCTION OF A VECTOR OF LOGICALS WITH DIFFUSION OF
!+                THE RESULT TO ALL THE PROCESSORS.
!
!history  O.BOITEAU (SINETICS)
!+        01/07/2006
!+        V5P9
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BUFFER_LENGTH          |-->| BUFFER SIZE
!| LBUFFER          |<->| SEND BUFFER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_parallel
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: BUFFER_LENGTH
      LOGICAL, DIMENSION(BUFFER_LENGTH), INTENT(INOUT) :: LBUFFER
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
#if defined HAVE_MPI
      LOGICAL, DIMENSION(:), ALLOCATABLE :: LAUX
      INTEGER IER,I
!
!-----------------------------------------------------------------------
!
      ALLOCATE(laux(buffer_length),stat=ier)
      CALL check_allocate(ier, 'LAUX')
!
      DO i=1,buffer_length
        laux(i)=lbuffer(i)
      ENDDO
!
      CALL mpi_allreduce(laux,lbuffer,buffer_length,mpi_logical,
     &                   mpi_lor,comm,ier)
!
      IF(ier.NE.0) THEN
        WRITE(lu,*) 'P_LSUM: ERROR IN MPI_ALLREDUCE'
        WRITE(lu,*) 'MPI ERROR: ',ier
!       CALL PLANTE(1)
        stop
      ENDIF
!
      DEALLOCATE(laux)
#else
      WRITE(lu,*) 'CALL OF P_LSUM IN ITS VOID VERSION'
!
      lbuffer = .false.
!
#endif
!
!-----------------------------------------------------------------------
!
      RETURN
      END