DTBMV performs one of the matrix-vector operations x := Ax, or x := ATx, where x is an n element vector and A is an n by n unit, or non-unit, upper or lower triangular band matrix, with ( k + 1 ) diagonals.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=1), | intent(in) | :: | uplo | |||
character(len=1), | intent(in) | :: | trans | |||
character(len=1), | intent(in) | :: | diag | |||
integer(kind=ilp), | intent(in) | :: | n | |||
integer(kind=ilp), | intent(in) | :: | k | |||
real(kind=dp), | intent(in) | :: | a(lda,*) | |||
integer(kind=ilp), | intent(in) | :: | lda | |||
real(kind=dp), | intent(inout) | :: | x(*) | |||
integer(kind=ilp), | intent(in) | :: | incx |
pure subroutine stdlib_dtbmv(uplo,trans,diag,n,k,a,lda,x,incx) !! DTBMV performs one of the matrix-vector operations !! x := A*x, or x := A**T*x, !! where x is an n element vector and A is an n by n unit, or non-unit, !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 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 integer(ilp), intent(in) :: incx, k, lda, n character, intent(in) :: diag, trans, uplo ! Array Arguments real(dp), intent(in) :: a(lda,*) real(dp), intent(inout) :: x(*) ! ===================================================================== ! Local Scalars real(dp) :: temp integer(ilp) :: i, info, ix, j, jx, kplus1, kx, l logical(lk) :: nounit ! Intrinsic Functions intrinsic :: max,min ! test the input parameters. info = 0 if (.not.stdlib_lsame(uplo,'U') .and. .not.stdlib_lsame(uplo,'L')) then info = 1 else if (.not.stdlib_lsame(trans,'N') .and. .not.stdlib_lsame(trans,'T') & .and..not.stdlib_lsame(trans,'C')) then info = 2 else if (.not.stdlib_lsame(diag,'U') .and. .not.stdlib_lsame(diag,'N')) then info = 3 else if (n<0) then info = 4 else if (k<0) then info = 5 else if (lda< (k+1)) then info = 7 else if (incx==0) then info = 9 end if if (info/=0) then call stdlib_xerbla('DTBMV ',info) return end if ! quick return if possible. if (n==0) return nounit = stdlib_lsame(diag,'N') ! set up the start point in x if the increment is not unity. this ! will be ( n - 1 )*incx too small for descending loops. if (incx<=0) then kx = 1 - (n-1)*incx else if (incx/=1) then kx = 1 end if ! start the operations. in this version the elements of a are ! accessed sequentially with one pass through a. if (stdlib_lsame(trans,'N')) then ! form x := a*x. if (stdlib_lsame(uplo,'U')) then kplus1 = k + 1 if (incx==1) then do j = 1,n if (x(j)/=zero) then temp = x(j) l = kplus1 - j do i = max(1,j-k),j - 1 x(i) = x(i) + temp*a(l+i,j) end do if (nounit) x(j) = x(j)*a(kplus1,j) end if end do else jx = kx do j = 1,n if (x(jx)/=zero) then temp = x(jx) ix = kx l = kplus1 - j do i = max(1,j-k),j - 1 x(ix) = x(ix) + temp*a(l+i,j) ix = ix + incx end do if (nounit) x(jx) = x(jx)*a(kplus1,j) end if jx = jx + incx if (j>k) kx = kx + incx end do end if else if (incx==1) then do j = n,1,-1 if (x(j)/=zero) then temp = x(j) l = 1 - j do i = min(n,j+k),j + 1,-1 x(i) = x(i) + temp*a(l+i,j) end do if (nounit) x(j) = x(j)*a(1,j) end if end do else kx = kx + (n-1)*incx jx = kx do j = n,1,-1 if (x(jx)/=zero) then temp = x(jx) ix = kx l = 1 - j do i = min(n,j+k),j + 1,-1 x(ix) = x(ix) + temp*a(l+i,j) ix = ix - incx end do if (nounit) x(jx) = x(jx)*a(1,j) end if jx = jx - incx if ((n-j)>=k) kx = kx - incx end do end if end if else ! form x := a**t*x. if (stdlib_lsame(uplo,'U')) then kplus1 = k + 1 if (incx==1) then do j = n,1,-1 temp = x(j) l = kplus1 - j if (nounit) temp = temp*a(kplus1,j) do i = j - 1,max(1,j-k),-1 temp = temp + a(l+i,j)*x(i) end do x(j) = temp end do else kx = kx + (n-1)*incx jx = kx do j = n,1,-1 temp = x(jx) kx = kx - incx ix = kx l = kplus1 - j if (nounit) temp = temp*a(kplus1,j) do i = j - 1,max(1,j-k),-1 temp = temp + a(l+i,j)*x(ix) ix = ix - incx end do x(jx) = temp jx = jx - incx end do end if else if (incx==1) then do j = 1,n temp = x(j) l = 1 - j if (nounit) temp = temp*a(1,j) do i = j + 1,min(n,j+k) temp = temp + a(l+i,j)*x(i) end do x(j) = temp end do else jx = kx do j = 1,n temp = x(jx) kx = kx + incx ix = kx l = 1 - j if (nounit) temp = temp*a(1,j) do i = j + 1,min(n,j+k) temp = temp + a(l+i,j)*x(ix) ix = ix + incx end do x(jx) = temp jx = jx + incx end do end if end if end if return end subroutine stdlib_dtbmv