p_dsumerr.F

Go to the documentation of this file.

!                   ***********************************
                    DOUBLE PRECISION FUNCTION p_dsumerr
!                   ***********************************
!
     &(partial)
!
!***********************************************************************
! PARALLEL   V7P3                                  24/02/2016
!***********************************************************************
!
!brief    SUM AND ERROR ROUNDING OF VALUES FROM ALL THE PROCESSORS.
!
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| PARTIAL         |-->| SEND BUFFER (SUM_VALUE, ERROR VALUE)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_parallel
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION, INTENT(IN) :: PARTIAL(2)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
#if defined (HAVE_MPI)
      INTEGER IER,NUM_PROCS
      DOUBLE PRECISION,ALLOCATABLE, DIMENSION(:)::ALL_PARTIAL_SUM
!
!-----------------------------------------------------------------------
!
#  ifdef COMPAD
        WRITE(lu,*) 'P_DSUMERR: NOT YET IMPLEMENTED'
        CALL plante(1)
        stop
#  else
      CALL mpi_comm_size (mpi_comm_world, num_procs, ier)
      ALLOCATE(all_partial_sum(1:2*num_procs))
      all_partial_sum=0.d0
      CALL mpi_allgather (partial, 2, mpi_double_precision,
     & all_partial_sum, 2, mpi_double_precision, mpi_comm_world, ier)
#  endif
!
      CALL sumtwo(2*num_procs, all_partial_sum, p_dsumerr)
      DEALLOCATE(all_partial_sum)
!
      IF(ier.NE.0) THEN
        WRITE(lu,*) 'P_DSUMERR: ERROR IN MPI_ALLGATHER'
        WRITE(lu,*) 'MPI ERROR: ',ier
        CALL plante(1)
        stop
      ENDIF
      RETURN
#else
      WRITE(lu,*) 'CALL OF P_DSUM IN ITS VOID VERSION'
!
      p_dsumerr=partial(1)
#endif
!
!-----------------------------------------------------------------------
!
      RETURN
      END