twoprod.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE twoprod
!                   ******************
!
     &(a,b,x,y)
!
!***********************************************************************
! BIEF   V7P3                                  24/02/2016
!***********************************************************************
!
!brief    SCALAR PRODUCT AND CALCULATE ROUNDING ERROR.
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A,B          |-->| DOUBLE PRECISION SCALAR
!| X            |<--| DOUBLE PRECISION PRODUC RESULT
!| Y            |<--| DOUBLE PRECISION ROUNDING ERROR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION, INTENT(IN)  :: A,B
      DOUBLE PRECISION, INTENT(OUT) :: X,Y
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION AH,AL,BH,BL
!
!-----------------------------------------------------------------------
!
      ah=0.d0
      al=0.d0
      bh=0.d0
      bl=0.d0
      x=a*b
      CALL split(a,ah,al)
      CALL split(b,bh,bl)
      y=al*bl-(((x-ah*bh)-al*bh)-ah*bl)
!
!
!-----------------------------------------------------------------------
!
      END
!
!-----------------------------------------------------------------------
!
!                   ****************
                    SUBROUTINE split
!                   ****************
     &  (a,x,y)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        DOUBLE PRECISION, INTENT(IN)  :: A
        DOUBLE PRECISION, INTENT(OUT) :: X,Y
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
        DOUBLE PRECISION Z
        INTEGER CONSTANTE
!
!-----------------------------------------------------------------------
!
        constante= 134217729
        z=0.d0
        z=constante*a
        x=z-(z-a)
        y=a-x
!
      END SUBROUTINE split
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!