stdlib_sdsdot Function

public pure function stdlib_sdsdot(n, sb, sx, incx, sy, incy)

Compute the inner product of two vectors with extended precision accumulation. Returns S.P. result with dot product accumulated in D.P. SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+IINCX)SY(LY+IINCY), where LX = 1 if INCX >= 0, else LX = 1+(1-N)INCX, and LY is defined in a similar way using INCY.

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(in) :: sb
real(kind=sp), intent(in) :: sx(*)
integer(kind=ilp), intent(in) :: incx
real(kind=sp), intent(in) :: sy(*)
integer(kind=ilp), intent(in) :: incy

Return Value real(kind=sp)


Source Code

     pure real(sp) function stdlib_sdsdot(n,sb,sx,incx,sy,incy)
     !! Compute the inner product of two vectors with extended
     !! precision accumulation.
     !! Returns S.P. result with dot product accumulated in D.P.
     !! SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
     !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is
     !! defined in a similar way using INCY.
        ! -- reference blas level1 routine --
        ! -- reference blas is a software package provided by univ. of tennessee,    --
        ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
           ! Scalar Arguments 
           real(sp), intent(in) :: sb
           integer(ilp), intent(in) :: incx, incy, n
           ! Array Arguments 
           real(sp), intent(in) :: sx(*), sy(*)
           ! Local Scalars 
           real(dp) :: dsdot
           integer(ilp) :: i, kx, ky, ns
           ! Intrinsic Functions 
           intrinsic :: real
           dsdot = sb
           if (n<=0) then
              stdlib_sdsdot = dsdot
              return
           end if
           if (incx==incy .and. incx>0) then
           ! code for equal and positive increments.
              ns = n*incx
              do i = 1,ns,incx
                 dsdot = dsdot + real(sx(i),KIND=sp)*real(sy(i),KIND=sp)
              end do
           else
           ! code for unequal or nonpositive increments.
              kx = 1
              ky = 1
              if (incx<0) kx = 1 + (1-n)*incx
              if (incy<0) ky = 1 + (1-n)*incy
              do i = 1,n
                 dsdot = dsdot + real(sx(kx),KIND=sp)*real(sy(ky),KIND=sp)
                 kx = kx + incx
                 ky = ky + incy
              end do
           end if
           stdlib_sdsdot = dsdot
           return
     end function stdlib_sdsdot