p_dotpair.f

Go to the documentation of this file.

!                   *********************
                    SUBROUTINE p_dotpair
!                   *********************
!
     &(npoin,x,y,ifac,pair)
!
!***********************************************************************
! BIEF   V7                                  24/02/2016
!***********************************************************************
!
!brief     SCALAR PRODUCT OF VECTORS X AND Y (SIZE NPOIN)
!+                TAKING PARALLELISM INTO ACCOUNT
!+                RETURN THE PAIR RESULT AND ERROR
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FAC            |-->| FAC=1/(NUMBER OF NEIGHBOURING SUB-DOMAINS)
!| NPOIN          |-->| SIZE OF X AND Y
!| X              |-->| VECTOR
!| Y              |-->| VECTOR
!| PAIR           |-->| DOT RESULT AND DOT ERROR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_p_dotpair => p_dotpair
!
      USE declarations_special
      IMPLICIT NONE
!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
      INTEGER, INTENT(IN) :: NPOIN
      DOUBLE PRECISION, INTENT(IN) :: X(npoin),Y(npoin)
      INTEGER, INTENT(IN)          :: IFAC(npoin)
      DOUBLE PRECISION, INTENT(OUT) ::PAIR(2)

!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
      DOUBLE PRECISION :: P,S,H,R,Q
      DOUBLE PRECISION :: TMP
      INTEGER I
!
!-----------------------------------------------------------------------
!
      p=0.d0
      s=0.d0
      h=0.d0
      r=0.d0
      q=0.d0
      pair=0.d0
      IF  (npoin .EQ. 0) THEN
        pair=0.d0
        RETURN
      END IF

      CALL twoprod(x(1),y(1)*ifac(1),p,s)

      DO i = 2 , npoin
        CALL twoprod(x(i),y(i)*ifac(i),h,r)
        tmp = p
        CALL twosum(tmp,h,p,q)
        s=s+(q+r)
      END DO
      CALL twosum(p,s,pair(1),pair(2))

!-----------------------------------------------------------------------
!
      RETURN
      END