sumtwo.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE sumtwo
!                   ******************
!
     &(n,p,res)
!
!***********************************************************************
! PARALLEL   V7P3                                  24/02/2016
!***********************************************************************
!
!brief    CALCULATE A COMPENSATED SUM OF A VECTOR.
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| N            |-->| INTEGER VECTOR SIZE
!| P            |-->| DOUBLE PRECISION VECTOR
!| Y            |<--| DOUBLE PRECISION VECTOR RESULT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER ,INTENT(IN) ::n
      DOUBLE PRECISION, INTENT(IN) :: p(n)
      DOUBLE PRECISION, INTENT(OUT) :: res
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION r(n)
      DOUBLE PRECISION tmp, tmp2
      INTEGER i
!
!-----------------------------------------------------------------------
!
      res=0.d0
      r=p
      DO i = 2 , n
        tmp = r(i)
        tmp2 = r(i-1)
        CALL twosum1(tmp,r(i-1),r(i),tmp2)
      END DO
      DO i = 1 , n-1
        res=res+r(i)
      END DO
      res=res+r(n)
!
!
!-----------------------------------------------------------------------
!
      END
      SUBROUTINE twosum1(A,B,X,Y)

      DOUBLE PRECISION, INTENT(IN)  :: a,b
      DOUBLE PRECISION, INTENT(OUT) :: x,y
      DOUBLE PRECISION z, xout
      xout=a+b
      z=xout-a
      y=(a-(xout-z))+(b-z)
      x = xout

      END