dot_comp.f

Go to the documentation of this file.

!                   **********************************
                    DOUBLE PRECISION FUNCTION dot_comp
!                   **********************************
!
     &(npoin,x,y)
!
!***********************************************************************
! BIEF   V7P3                                   24/02/2016
!***********************************************************************
!
!brief   COMPENSATED SCALAR PRODUCT OF VECTORS X AND Y OF SIZE NPOIN.
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NPOIN          |-->| TAILLE DE X ET Y
!| X              |-->| FIRST DOUBLE PRECISION VECTOR
!| Y              |-->| SECOND DOUBLE PRECISION VECTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN
      DOUBLE PRECISION, INTENT(IN) :: X(npoin),Y(npoin)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
      DOUBLE PRECISION :: P,S,H,R,Q
      DOUBLE PRECISION TMP
!
!-----------------------------------------------------------------------
!
      IF(npoin .EQ. 0) THEN
        dot_comp=0.d0
        RETURN
      ENDIF
!
      dot_comp = 0.d0
      p=0.d0
      s=0.d0
      h=0.d0
      r=0.d0
      q=0.d0
!
      CALL twoprod(x(1),y(1),p,s)
!
      DO i = 2 , npoin
!
        h=0.d0
        r=0.d0
        q=0.d0
        CALL twoprod(x(i),y(i),h,r)
        tmp = p
        CALL twosum(tmp,h,p,q)
        s=s+(q+r)
!
      END DO
      dot_comp = p+s
!
!-----------------------------------------------------------------------
!
      RETURN
      END