#:include "common.fypp"
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
module stdlib_linalg_blas
use stdlib_linalg_constants
use stdlib_linalg_blas_aux
#:for rk,rt,ri in RC_KINDS_TYPES
use stdlib_linalg_blas_${ri}$
#:endfor
implicit none(type,external)
public
interface asum
!! ASUM takes the sum of the absolute values.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function dasum( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(in) :: x(*)
end function dasum
#else
module procedure stdlib${ii}$_dasum
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function dzasum( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(in) :: x(*)
end function dzasum
#else
module procedure stdlib${ii}$_dzasum
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(sp) function sasum( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(in) :: x(*)
end function sasum
#else
module procedure stdlib${ii}$_sasum
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(sp) function scasum( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(in) :: x(*)
end function scasum
#else
module procedure stdlib${ii}$_scasum
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$asum
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${c2ri(ri)}$zasum
#:endif
#:endfor
#:endfor
end interface asum
interface axpy
!! AXPY constant times a vector plus a vector.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine caxpy(n,ca,cx,incx,cy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: ca,cx(*)
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(inout) :: cy(*)
end subroutine caxpy
#else
module procedure stdlib${ii}$_caxpy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine daxpy(n,da,dx,incx,dy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: da,dx(*)
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(inout) :: dy(*)
end subroutine daxpy
#else
module procedure stdlib${ii}$_daxpy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine saxpy(n,sa,sx,incx,sy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: sa,sx(*)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(inout) :: sy(*)
end subroutine saxpy
#else
module procedure stdlib${ii}$_saxpy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zaxpy(n,za,zx,incx,zy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: za,zx(*)
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(inout) :: zy(*)
end subroutine zaxpy
#else
module procedure stdlib${ii}$_zaxpy
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$axpy
#:endif
#:endfor
#:endfor
end interface axpy
interface copy
!! COPY copies a vector x to a vector y.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ccopy(n,cx,incx,cy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(in) :: cx(*)
complex(sp), intent(out) :: cy(*)
end subroutine ccopy
#else
module procedure stdlib${ii}$_ccopy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dcopy(n,dx,incx,dy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(in) :: dx(*)
real(dp), intent(out) :: dy(*)
end subroutine dcopy
#else
module procedure stdlib${ii}$_dcopy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine scopy(n,sx,incx,sy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(in) :: sx(*)
real(sp), intent(out) :: sy(*)
end subroutine scopy
#else
module procedure stdlib${ii}$_scopy
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zcopy(n,zx,incx,zy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(in) :: zx(*)
complex(dp), intent(out) :: zy(*)
end subroutine zcopy
#else
module procedure stdlib${ii}$_zcopy
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$copy
#:endif
#:endfor
#:endfor
end interface copy
interface dot
!! DOT forms the dot product of two vectors.
!! uses unrolled loops for increments equal to one.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function ddot(n,dx,incx,dy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(in) :: dx(*),dy(*)
end function ddot
#else
module procedure stdlib${ii}$_ddot
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(sp) function sdot(n,sx,incx,sy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(in) :: sx(*),sy(*)
end function sdot
#else
module procedure stdlib${ii}$_sdot
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$dot
#:endif
#:endfor
#:endfor
end interface dot
interface dotc
!! DOTC forms the dot product of two complex vectors
!! DOTC = X^H * Y
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure complex(sp) function cdotc(n,cx,incx,cy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(in) :: cx(*),cy(*)
end function cdotc
#else
module procedure stdlib${ii}$_cdotc
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure complex(dp) function zdotc(n,zx,incx,zy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(in) :: zx(*),zy(*)
end function zdotc
#else
module procedure stdlib${ii}$_zdotc
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$dotc
#:endif
#:endfor
#:endfor
end interface dotc
interface dotu
!! DOTU forms the dot product of two complex vectors
!! DOTU = X^T * Y
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure complex(sp) function cdotu(n,cx,incx,cy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(in) :: cx(*),cy(*)
end function cdotu
#else
module procedure stdlib${ii}$_cdotu
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure complex(dp) function zdotu(n,zx,incx,zy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(in) :: zx(*),zy(*)
end function zdotu
#else
module procedure stdlib${ii}$_zdotu
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$dotu
#:endif
#:endfor
#:endfor
end interface dotu
interface gbmv
!! GBMV performs one of the matrix-vector operations
!! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or
!! y := alpha*A**H*x + beta*y,
!! where alpha and beta are scalars, x and y are vectors and A is an
!! m by n band matrix, with kl sub-diagonals and ku super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,kl,ku,lda,m,n
character, intent(in) :: trans
complex(sp), intent(inout) :: y(*)
end subroutine cgbmv
#else
module procedure stdlib${ii}$_cgbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,kl,ku,lda,m,n
character, intent(in) :: trans
real(dp), intent(inout) :: y(*)
end subroutine dgbmv
#else
module procedure stdlib${ii}$_dgbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,kl,ku,lda,m,n
character, intent(in) :: trans
real(sp), intent(inout) :: y(*)
end subroutine sgbmv
#else
module procedure stdlib${ii}$_sgbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,kl,ku,lda,m,n
character, intent(in) :: trans
complex(dp), intent(inout) :: y(*)
end subroutine zgbmv
#else
module procedure stdlib${ii}$_zgbmv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbmv
#:endif
#:endfor
#:endfor
end interface gbmv
interface gemm
!! GEMM performs one of the matrix-matrix operations
!! C := alpha*op( A )*op( B ) + beta*C,
!! where op( X ) is one of
!! op( X ) = X or op( X ) = X**T or op( X ) = X**H,
!! alpha and beta are scalars, and A, B and C are matrices, with op( A )
!! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,m,n
character, intent(in) :: transa,transb
complex(sp), intent(inout) :: c(ldc,*)
end subroutine cgemm
#else
module procedure stdlib${ii}$_cgemm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,m,n
character, intent(in) :: transa,transb
real(dp), intent(inout) :: c(ldc,*)
end subroutine dgemm
#else
module procedure stdlib${ii}$_dgemm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,m,n
character, intent(in) :: transa,transb
real(sp), intent(inout) :: c(ldc,*)
end subroutine sgemm
#else
module procedure stdlib${ii}$_sgemm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,m,n
character, intent(in) :: transa,transb
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zgemm
#else
module procedure stdlib${ii}$_zgemm
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemm
#:endif
#:endfor
#:endfor
end interface gemm
interface gemv
!! GEMV performs one of the matrix-vector operations
!! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or
!! y := alpha*A**H*x + beta*y,
!! where alpha and beta are scalars, x and y are vectors and A is an
!! m by n matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
character, intent(in) :: trans
complex(sp), intent(inout) :: y(*)
end subroutine cgemv
#else
module procedure stdlib${ii}$_cgemv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
character, intent(in) :: trans
real(dp), intent(inout) :: y(*)
end subroutine dgemv
#else
module procedure stdlib${ii}$_dgemv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
character, intent(in) :: trans
real(sp), intent(inout) :: y(*)
end subroutine sgemv
#else
module procedure stdlib${ii}$_sgemv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
character, intent(in) :: trans
complex(dp), intent(inout) :: y(*)
end subroutine zgemv
#else
module procedure stdlib${ii}$_zgemv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemv
#:endif
#:endfor
#:endfor
end interface gemv
interface ger
!! GER performs the rank 1 operation
!! A := alpha*x*y**T + A,
!! where alpha is a scalar, x is an m element vector, y is an n element
!! vector and A is an m by n matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dger(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
real(dp), intent(inout) :: a(lda,*)
end subroutine dger
#else
module procedure stdlib${ii}$_dger
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sger(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
real(sp), intent(inout) :: a(lda,*)
end subroutine sger
#else
module procedure stdlib${ii}$_sger
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ger
#:endif
#:endfor
#:endfor
end interface ger
interface gerc
!! GERC performs the rank 1 operation
!! A := alpha*x*y**H + A,
!! where alpha is a scalar, x is an m element vector, y is an n element
!! vector and A is an m by n matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cgerc(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
complex(sp), intent(inout) :: a(lda,*)
end subroutine cgerc
#else
module procedure stdlib${ii}$_cgerc
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zgerc(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
complex(dp), intent(inout) :: a(lda,*)
end subroutine zgerc
#else
module procedure stdlib${ii}$_zgerc
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gerc
#:endif
#:endfor
#:endfor
end interface gerc
interface geru
!! GERU performs the rank 1 operation
!! A := alpha*x*y**T + A,
!! where alpha is a scalar, x is an m element vector, y is an n element
!! vector and A is an m by n matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cgeru(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
complex(sp), intent(inout) :: a(lda,*)
end subroutine cgeru
#else
module procedure stdlib${ii}$_cgeru
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zgeru(m,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n
complex(dp), intent(inout) :: a(lda,*)
end subroutine zgeru
#else
module procedure stdlib${ii}$_zgeru
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geru
#:endif
#:endfor
#:endfor
end interface geru
interface hbmv
!! HBMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n hermitian band matrix, with k super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,k,lda,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: y(*)
end subroutine chbmv
#else
module procedure stdlib${ii}$_chbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,k,lda,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: y(*)
end subroutine zhbmv
#else
module procedure stdlib${ii}$_zhbmv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbmv
#:endif
#:endfor
#:endfor
end interface hbmv
interface hemm
!! HEMM performs one of the matrix-matrix operations
!! C := alpha*A*B + beta*C,
!! or
!! C := alpha*B*A + beta*C,
!! where alpha and beta are scalars, A is an hermitian matrix and B and
!! C are m by n matrices.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
complex(sp), intent(inout) :: c(ldc,*)
end subroutine chemm
#else
module procedure stdlib${ii}$_chemm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zhemm
#else
module procedure stdlib${ii}$_zhemm
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hemm
#:endif
#:endfor
#:endfor
end interface hemm
interface hemv
!! HEMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n hermitian matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: y(*)
end subroutine chemv
#else
module procedure stdlib${ii}$_chemv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: y(*)
end subroutine zhemv
#else
module procedure stdlib${ii}$_zhemv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hemv
#:endif
#:endfor
#:endfor
end interface hemv
interface her
!! HER performs the hermitian rank 1 operation
!! A := alpha*x*x**H + A,
!! where alpha is a real scalar, x is an n element vector and A is an
!! n by n hermitian matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cher(uplo,n,alpha,x,incx,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(in) :: x(*)
end subroutine cher
#else
module procedure stdlib${ii}$_cher
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zher(uplo,n,alpha,x,incx,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(in) :: x(*)
end subroutine zher
#else
module procedure stdlib${ii}$_zher
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$her
#:endif
#:endfor
#:endfor
end interface her
interface her2
!! HER2 performs the hermitian rank 2 operation
!! A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
!! where alpha is a scalar, x and y are n element vectors and A is an n
!! by n hermitian matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cher2(uplo,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: a(lda,*)
end subroutine cher2
#else
module procedure stdlib${ii}$_cher2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zher2(uplo,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: a(lda,*)
end subroutine zher2
#else
module procedure stdlib${ii}$_zher2
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$her2
#:endif
#:endfor
#:endfor
end interface her2
interface her2k
!! HER2K performs one of the hermitian rank 2k operations
!! C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C,
!! or
!! C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C,
!! where alpha and beta are scalars with beta real, C is an n by n
!! hermitian matrix and A and B are n by k matrices in the first case
!! and k by n matrices in the second case.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,a(lda,*),b(ldb,*)
real(sp), intent(in) :: beta
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
complex(sp), intent(inout) :: c(ldc,*)
end subroutine cher2k
#else
module procedure stdlib${ii}$_cher2k
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,a(lda,*),b(ldb,*)
real(dp), intent(in) :: beta
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zher2k
#else
module procedure stdlib${ii}$_zher2k
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$her2k
#:endif
#:endfor
#:endfor
end interface her2k
interface herk
!! HERK performs one of the hermitian rank k operations
!! C := alpha*A*A**H + beta*C,
!! or
!! C := alpha*A**H*A + beta*C,
!! where alpha and beta are real scalars, C is an n by n hermitian
!! matrix and A is an n by k matrix in the first case and a k by n
!! matrix in the second case.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: c(ldc,*)
end subroutine cherk
#else
module procedure stdlib${ii}$_cherk
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zherk
#else
module procedure stdlib${ii}$_zherk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$herk
#:endif
#:endfor
#:endfor
end interface herk
interface hpmv
!! HPMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n hermitian matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,ap(*),x(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: y(*)
end subroutine chpmv
#else
module procedure stdlib${ii}$_chpmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhpmv(uplo,n,alpha,ap,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,ap(*),x(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: y(*)
end subroutine zhpmv
#else
module procedure stdlib${ii}$_zhpmv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpmv
#:endif
#:endfor
#:endfor
end interface hpmv
interface hpr
!! HPR performs the hermitian rank 1 operation
!! A := alpha*x*x**H + A,
!! where alpha is a real scalar, x is an n element vector and A is an
!! n by n hermitian matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chpr(uplo,n,alpha,x,incx,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(in) :: x(*)
end subroutine chpr
#else
module procedure stdlib${ii}$_chpr
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhpr(uplo,n,alpha,x,incx,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(in) :: x(*)
end subroutine zhpr
#else
module procedure stdlib${ii}$_zhpr
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpr
#:endif
#:endfor
#:endfor
end interface hpr
interface hpr2
!! HPR2 performs the hermitian rank 2 operation
!! A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
!! where alpha is a scalar, x and y are n element vectors and A is an
!! n by n hermitian matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine chpr2(uplo,n,alpha,x,incx,y,incy,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
complex(sp), intent(inout) :: ap(*)
end subroutine chpr2
#else
module procedure stdlib${ii}$_chpr2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zhpr2(uplo,n,alpha,x,incx,y,incy,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
complex(dp), intent(inout) :: ap(*)
end subroutine zhpr2
#else
module procedure stdlib${ii}$_zhpr2
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpr2
#:endif
#:endfor
#:endfor
end interface hpr2
interface nrm2
!! NRM2 returns the euclidean norm of a vector via the function
!! name, so that
!! NRM2 := sqrt( x'*x )
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function dnrm2( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(in) :: x(*)
end function dnrm2
#else
module procedure stdlib${ii}$_dnrm2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function dznrm2( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(in) :: x(*)
end function dznrm2
#else
module procedure stdlib${ii}$_dznrm2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(sp) function snrm2( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(in) :: x(*)
end function snrm2
#else
module procedure stdlib${ii}$_snrm2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(sp) function scnrm2( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(in) :: x(*)
end function scnrm2
#else
module procedure stdlib${ii}$_scnrm2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$nrm2
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${c2ri(ri)}$znrm2
#:endif
#:endfor
#:endfor
end interface nrm2
interface rot
!! ROT applies a plane rotation.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine drot(n,dx,incx,dy,incy,c,s)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: c,s
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(inout) :: dx(*),dy(*)
end subroutine drot
#else
module procedure stdlib${ii}$_drot
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine srot(n,sx,incx,sy,incy,c,s)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: c,s
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(inout) :: sx(*),sy(*)
end subroutine srot
#else
module procedure stdlib${ii}$_srot
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$rot
#:endif
#:endfor
#:endfor
end interface rot
interface rotg
!! The computation uses the formulas
!! |x| = sqrt( Re(x)**2 + Im(x)**2 )
!! sgn(x) = x / |x| if x /= 0
!! = 1 if x = 0
!! c = |a| / sqrt(|a|**2 + |b|**2)
!! s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2)
!! When a and b are real and r /= 0, the formulas simplify to
!! r = sgn(a)*sqrt(|a|**2 + |b|**2)
!! c = a / r
!! s = b / r
!! the same as in SROTG when |a| > |b|. When |b| >= |a|, the
!! sign of c and s will be different from those computed by SROTG
!! if the signs of a and b are not the same.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine crotg( a, b, c, s )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(out) :: c
complex(sp), intent(inout) :: a
complex(sp), intent(in) :: b
complex(sp), intent(out) :: s
end subroutine crotg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_crotg
#:endif
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine drotg( a, b, c, s )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(inout) :: a,b
real(dp), intent(out) :: c,s
end subroutine drotg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_drotg
#:endif
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine srotg( a, b, c, s )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(inout) :: a,b
real(sp), intent(out) :: c,s
end subroutine srotg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_srotg
#:endif
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zrotg( a, b, c, s )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(out) :: c
complex(dp), intent(inout) :: a
complex(dp), intent(in) :: b
complex(dp), intent(out) :: s
end subroutine zrotg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_zrotg
#:endif
#endif
#:endfor
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$rotg
#:endif
#:endfor
end interface rotg
interface rotm
!! ROTM applies the modified Givens transformation, \(H\), to the 2-by-N matrix
!! $$ \left[ \begin{array}{c}DX^T\\DY^T\\ \end{array} \right], $$
!! where \(^T\) indicates transpose. The elements of \(DX\) are in
!! DX(LX+I*INCX), I = 0:N-1, where LX = 1 if INCX >= 0, else LX = (-INCX)*N,
!! and similarly for DY using LY and INCY.
!! With DPARAM(1)=DFLAG, \(H\) has one of the following forms:
!! $$ H=\underbrace{\begin{bmatrix}DH_{11} & DH_{12}\\DH_{21} & DH_{22}\end{bmatrix}}_{DFLAG=-1},
!! \underbrace{\begin{bmatrix}1 & DH_{12}\\DH_{21} & 1\end{bmatrix}}_{DFLAG=0},
!! \underbrace{\begin{bmatrix}DH_{11} & 1\\-1 & DH_{22}\end{bmatrix}}_{DFLAG=1},
!! \underbrace{\begin{bmatrix}1 & 0\\0 & 1\end{bmatrix}}_{DFLAG=-2}. $$
!! See ROTMG for a description of data storage in DPARAM.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine drotm(n,dx,incx,dy,incy,dparam)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(in) :: dparam(5)
real(dp), intent(inout) :: dx(*),dy(*)
end subroutine drotm
#else
module procedure stdlib${ii}$_drotm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine srotm(n,sx,incx,sy,incy,sparam)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(in) :: sparam(5)
real(sp), intent(inout) :: sx(*),sy(*)
end subroutine srotm
#else
module procedure stdlib${ii}$_srotm
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$rotm
#:endif
#:endfor
#:endfor
end interface rotm
interface rotmg
!! ROTMG Constructs the modified Givens transformation matrix \(H\) which zeros the
!! second component of the 2-vector
!! $$ \left[ {\sqrt{DD_1}\cdot DX_1,\sqrt{DD_2}\cdot DY_2} \right]^T. $$
!! With DPARAM(1)=DFLAG, \(H\) has one of the following forms:
!! $$ H=\underbrace{\begin{bmatrix}DH_{11} & DH_{12}\\DH_{21} & DH_{22}\end{bmatrix}}_{DFLAG=-1},
!! \underbrace{\begin{bmatrix}1 & DH_{12}\\DH_{21} & 1\end{bmatrix}}_{DFLAG=0},
!! \underbrace{\begin{bmatrix}DH_{11} & 1\\-1 & DH_{22}\end{bmatrix}}_{DFLAG=1},
!! \underbrace{\begin{bmatrix}1 & 0\\0 & 1\end{bmatrix}}_{DFLAG=-2}. $$
!! Locations 2-4 of DPARAM contain DH11, DH21, DH12 and DH22 respectively.
!! (Values of 1.0, -1.0, or 0.0 implied by the value of DPARAM(1) are not stored in DPARAM.)
!! The values of parameters GAMSQ and RGAMSQ may be inexact. This is OK as they are only
!! used for testing the size of DD1 and DD2. All actual scaling of data is done using GAM.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine drotmg(dd1,dd2,dx1,dy1,dparam)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(inout) :: dd1,dd2,dx1
real(dp), intent(in) :: dy1
real(dp), intent(out) :: dparam(5)
end subroutine drotmg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_drotmg
#:endif
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine srotmg(sd1,sd2,sx1,sy1,sparam)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(inout) :: sd1,sd2,sx1
real(sp), intent(in) :: sy1
real(sp), intent(out) :: sparam(5)
end subroutine srotmg
#:if not 'ilp64' in ik
#else
module procedure stdlib_srotmg
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$rotmg
#:endif
#:endfor
end interface rotmg
interface sbmv
!! SBMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n symmetric band matrix, with k super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,k,lda,n
character, intent(in) :: uplo
real(dp), intent(inout) :: y(*)
end subroutine dsbmv
#else
module procedure stdlib${ii}$_dsbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,k,lda,n
character, intent(in) :: uplo
real(sp), intent(inout) :: y(*)
end subroutine ssbmv
#else
module procedure stdlib${ii}$_ssbmv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$sbmv
#:endif
#:endfor
#:endfor
end interface sbmv
interface scal
!! SCAL scales a vector by a constant.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cscal(n,ca,cx,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: ca
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(inout) :: cx(*)
end subroutine cscal
#else
module procedure stdlib${ii}$_cscal
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dscal(n,da,dx,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: da
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(inout) :: dx(*)
end subroutine dscal
#else
module procedure stdlib${ii}$_dscal
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sscal(n,sa,sx,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: sa
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(inout) :: sx(*)
end subroutine sscal
#else
module procedure stdlib${ii}$_sscal
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zscal(n,za,zx,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: za
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(inout) :: zx(*)
end subroutine zscal
#else
module procedure stdlib${ii}$_zscal
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$scal
#:endif
#:endfor
#:endfor
end interface scal
interface sdot
!! Compute the inner product of two vectors with extended
!! precision accumulation and result.
!! Returns D.P. dot product accumulated in D.P., for S.P. SX and SY
!! SDOT = 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.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#:if WITH_QP
!! Provide a unique interface to accumulate double precision reals
!! into the highest available precision.
module procedure stdlib${ii}$_qsdot
#:elif WITH_XDP
!! Provide a unique interface to accumulate double precision reals
!! into the highest available precision.
module procedure stdlib${ii}$_xsdot
#:endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure real(dp) function dsdot(n,sx,incx,sy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(in) :: sx(*),sy(*)
end function dsdot
#else
module procedure stdlib${ii}$_dsdot
#endif
#:endfor
end interface sdot
interface spmv
!! SPMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n symmetric matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,ap(*),x(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
real(dp), intent(inout) :: y(*)
end subroutine dspmv
#else
module procedure stdlib${ii}$_dspmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,ap(*),x(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
real(sp), intent(inout) :: y(*)
end subroutine sspmv
#else
module procedure stdlib${ii}$_sspmv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$spmv
#:endif
#:endfor
#:endfor
end interface spmv
interface spr
!! SPR performs the symmetric rank 1 operation
!! A := alpha*x*x**T + A,
!! where alpha is a real scalar, x is an n element vector and A is an
!! n by n symmetric matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dspr(uplo,n,alpha,x,incx,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,x(*)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: uplo
real(dp), intent(inout) :: ap(*)
end subroutine dspr
#else
module procedure stdlib${ii}$_dspr
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sspr(uplo,n,alpha,x,incx,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,x(*)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: uplo
real(sp), intent(inout) :: ap(*)
end subroutine sspr
#else
module procedure stdlib${ii}$_sspr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$spr
#:endif
#:endfor
#:endfor
end interface spr
interface spr2
!! SPR2 performs the symmetric rank 2 operation
!! A := alpha*x*y**T + alpha*y*x**T + A,
!! where alpha is a scalar, x and y are n element vectors and A is an
!! n by n symmetric matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dspr2(uplo,n,alpha,x,incx,y,incy,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
real(dp), intent(inout) :: ap(*)
end subroutine dspr2
#else
module procedure stdlib${ii}$_dspr2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sspr2(uplo,n,alpha,x,incx,y,incy,ap)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,n
character, intent(in) :: uplo
real(sp), intent(inout) :: ap(*)
end subroutine sspr2
#else
module procedure stdlib${ii}$_sspr2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$spr2
#:endif
#:endfor
#:endfor
end interface spr2
interface srot
!! SROT applies a plane rotation, where the cos and sin (c and s) are real
!! and the vectors cx and cy are complex.
!! jack dongarra, linpack, 3/11/78.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine csrot( n, cx, incx, cy, incy, c, s )
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(in) :: c,s
complex(sp), intent(inout) :: cx(*),cy(*)
end subroutine csrot
#else
module procedure stdlib${ii}$_csrot
#endif
#:endfor
end interface srot
interface sscal
!! SSCAL scales a complex vector by a real constant.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine csscal(n,sa,cx,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: sa
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(inout) :: cx(*)
end subroutine csscal
#else
module procedure stdlib${ii}$_csscal
#endif
#:endfor
end interface sscal
interface swap
!! SWAP interchanges two vectors.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine cswap(n,cx,incx,cy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(inout) :: cx(*),cy(*)
end subroutine cswap
#else
module procedure stdlib${ii}$_cswap
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dswap(n,dx,incx,dy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(inout) :: dx(*),dy(*)
end subroutine dswap
#else
module procedure stdlib${ii}$_dswap
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine sswap(n,sx,incx,sy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(inout) :: sx(*),sy(*)
end subroutine sswap
#else
module procedure stdlib${ii}$_sswap
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zswap(n,zx,incx,zy,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(inout) :: zx(*),zy(*)
end subroutine zswap
#else
module procedure stdlib${ii}$_zswap
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$swap
#:endif
#:endfor
#:endfor
end interface swap
interface symm
!! SYMM performs one of the matrix-matrix operations
!! C := alpha*A*B + beta*C,
!! or
!! C := alpha*B*A + beta*C,
!! where alpha and beta are scalars, A is a symmetric matrix and B and
!! C are m by n matrices.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
complex(sp), intent(inout) :: c(ldc,*)
end subroutine csymm
#else
module procedure stdlib${ii}$_csymm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
real(dp), intent(inout) :: c(ldc,*)
end subroutine dsymm
#else
module procedure stdlib${ii}$_dsymm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
real(sp), intent(inout) :: c(ldc,*)
end subroutine ssymm
#else
module procedure stdlib${ii}$_ssymm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
character, intent(in) :: side,uplo
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zsymm
#else
module procedure stdlib${ii}$_zsymm
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$symm
#:endif
#:endfor
#:endfor
end interface symm
interface symv
!! SYMV performs the matrix-vector operation
!! y := alpha*A*x + beta*y,
!! where alpha and beta are scalars, x and y are n element vectors and
!! A is an n by n symmetric matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
real(dp), intent(inout) :: y(*)
end subroutine dsymv
#else
module procedure stdlib${ii}$_dsymv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
real(sp), intent(inout) :: y(*)
end subroutine ssymv
#else
module procedure stdlib${ii}$_ssymv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$symv
#:endif
#:endfor
#:endfor
end interface symv
interface syr
!! SYR performs the symmetric rank 1 operation
!! A := alpha*x*x**T + A,
!! where alpha is a real scalar, x is an n element vector and A is an
!! n by n symmetric matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsyr(uplo,n,alpha,x,incx,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,x(*)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: uplo
real(dp), intent(inout) :: a(lda,*)
end subroutine dsyr
#else
module procedure stdlib${ii}$_dsyr
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssyr(uplo,n,alpha,x,incx,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,x(*)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: uplo
real(sp), intent(inout) :: a(lda,*)
end subroutine ssyr
#else
module procedure stdlib${ii}$_ssyr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$syr
#:endif
#:endfor
#:endfor
end interface syr
interface syr2
!! SYR2 performs the symmetric rank 2 operation
!! A := alpha*x*y**T + alpha*y*x**T + A,
!! where alpha is a scalar, x and y are n element vectors and A is an n
!! by n symmetric matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
real(dp), intent(inout) :: a(lda,*)
end subroutine dsyr2
#else
module procedure stdlib${ii}$_dsyr2
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssyr2(uplo,n,alpha,x,incx,y,incy,a,lda)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,x(*),y(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n
character, intent(in) :: uplo
real(sp), intent(inout) :: a(lda,*)
end subroutine ssyr2
#else
module procedure stdlib${ii}$_ssyr2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$syr2
#:endif
#:endfor
#:endfor
end interface syr2
interface syr2k
!! SYR2K performs one of the symmetric rank 2k operations
!! C := alpha*A*B**T + alpha*B*A**T + beta*C,
!! or
!! C := alpha*A**T*B + alpha*B**T*A + beta*C,
!! where alpha and beta are scalars, C is an n by n symmetric matrix
!! and A and B are n by k matrices in the first case and k by n
!! matrices in the second case.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
complex(sp), intent(inout) :: c(ldc,*)
end subroutine csyr2k
#else
module procedure stdlib${ii}$_csyr2k
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
real(dp), intent(inout) :: c(ldc,*)
end subroutine dsyr2k
#else
module procedure stdlib${ii}$_dsyr2k
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
real(sp), intent(inout) :: c(ldc,*)
end subroutine ssyr2k
#else
module procedure stdlib${ii}$_ssyr2k
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*),b(ldb,*)
integer(${ik}$), intent(in) :: k,lda,ldb,ldc,n
character, intent(in) :: trans,uplo
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zsyr2k
#else
module procedure stdlib${ii}$_zsyr2k
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$syr2k
#:endif
#:endfor
#:endfor
end interface syr2k
interface syrk
!! SYRK performs one of the symmetric rank k operations
!! C := alpha*A*A**T + beta*C,
!! or
!! C := alpha*A**T*A + beta*C,
!! where alpha and beta are scalars, C is an n by n symmetric matrix
!! and A is an n by k matrix in the first case and a k by n matrix
!! in the second case.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,beta,a(lda,*)
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
complex(sp), intent(inout) :: c(ldc,*)
end subroutine csyrk
#else
module procedure stdlib${ii}$_csyrk
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,beta,a(lda,*)
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
real(dp), intent(inout) :: c(ldc,*)
end subroutine dsyrk
#else
module procedure stdlib${ii}$_dsyrk
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ssyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,beta,a(lda,*)
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
real(sp), intent(inout) :: c(ldc,*)
end subroutine ssyrk
#else
module procedure stdlib${ii}$_ssyrk
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine zsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,beta,a(lda,*)
integer(${ik}$), intent(in) :: k,lda,ldc,n
character, intent(in) :: trans,uplo
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zsyrk
#else
module procedure stdlib${ii}$_zsyrk
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$syrk
#:endif
#:endfor
#:endfor
end interface syrk
interface tbmv
!! TBMV performs one of the matrix-vector operations
!! x := A*x, or x := A**T*x, or x := A**H*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.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctbmv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: x(*)
end subroutine ctbmv
#else
module procedure stdlib${ii}$_ctbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtbmv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: a(lda,*)
real(dp), intent(inout) :: x(*)
end subroutine dtbmv
#else
module procedure stdlib${ii}$_dtbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine stbmv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: a(lda,*)
real(sp), intent(inout) :: x(*)
end subroutine stbmv
#else
module procedure stdlib${ii}$_stbmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztbmv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: x(*)
end subroutine ztbmv
#else
module procedure stdlib${ii}$_ztbmv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$tbmv
#:endif
#:endfor
#:endfor
end interface tbmv
interface tbsv
!! TBSV solves one of the systems of equations
!! A*x = b, or A**T*x = b, or A**H*x = b,
!! where b and x are n element vectors and A is an n by n unit, or
!! non-unit, upper or lower triangular band matrix, with ( k + 1 )
!! diagonals.
!! No test for singularity or near-singularity is included in this
!! routine. Such tests must be performed before calling this routine.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctbsv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: x(*)
end subroutine ctbsv
#else
module procedure stdlib${ii}$_ctbsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtbsv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: a(lda,*)
real(dp), intent(inout) :: x(*)
end subroutine dtbsv
#else
module procedure stdlib${ii}$_dtbsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine stbsv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: a(lda,*)
real(sp), intent(inout) :: x(*)
end subroutine stbsv
#else
module procedure stdlib${ii}$_stbsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztbsv(uplo,trans,diag,n,k,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,k,lda,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: x(*)
end subroutine ztbsv
#else
module procedure stdlib${ii}$_ztbsv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$tbsv
#:endif
#:endfor
#:endfor
end interface tbsv
interface tpmv
!! TPMV performs one of the matrix-vector operations
!! x := A*x, or x := A**T*x, or x := A**H*x,
!! where x is an n element vector and A is an n by n unit, or non-unit,
!! upper or lower triangular matrix, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctpmv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: ap(*)
complex(sp), intent(inout) :: x(*)
end subroutine ctpmv
#else
module procedure stdlib${ii}$_ctpmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtpmv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: ap(*)
real(dp), intent(inout) :: x(*)
end subroutine dtpmv
#else
module procedure stdlib${ii}$_dtpmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine stpmv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: ap(*)
real(sp), intent(inout) :: x(*)
end subroutine stpmv
#else
module procedure stdlib${ii}$_stpmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztpmv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: ap(*)
complex(dp), intent(inout) :: x(*)
end subroutine ztpmv
#else
module procedure stdlib${ii}$_ztpmv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$tpmv
#:endif
#:endfor
#:endfor
end interface tpmv
interface tpsv
!! TPSV solves one of the systems of equations
!! A*x = b, or A**T*x = b, or A**H*x = b,
!! where b and x are n element vectors and A is an n by n unit, or
!! non-unit, upper or lower triangular matrix, supplied in packed form.
!! No test for singularity or near-singularity is included in this
!! routine. Such tests must be performed before calling this routine.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctpsv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: ap(*)
complex(sp), intent(inout) :: x(*)
end subroutine ctpsv
#else
module procedure stdlib${ii}$_ctpsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtpsv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: ap(*)
real(dp), intent(inout) :: x(*)
end subroutine dtpsv
#else
module procedure stdlib${ii}$_dtpsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine stpsv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: ap(*)
real(sp), intent(inout) :: x(*)
end subroutine stpsv
#else
module procedure stdlib${ii}$_stpsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztpsv(uplo,trans,diag,n,ap,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: ap(*)
complex(dp), intent(inout) :: x(*)
end subroutine ztpsv
#else
module procedure stdlib${ii}$_ztpsv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$tpsv
#:endif
#:endfor
#:endfor
end interface tpsv
interface trmm
!! TRMM performs one of the matrix-matrix operations
!! B := alpha*op( A )*B, or B := alpha*B*op( A )
!! where alpha is a scalar, B is an m by n matrix, A is a unit, or
!! non-unit, upper or lower triangular matrix and op( A ) is one of
!! op( A ) = A or op( A ) = A**T or op( A ) = A**H.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
complex(sp), intent(inout) :: b(ldb,*)
end subroutine ctrmm
#else
module procedure stdlib${ii}$_ctrmm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
real(dp), intent(inout) :: b(ldb,*)
end subroutine dtrmm
#else
module procedure stdlib${ii}$_dtrmm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine strmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
real(sp), intent(inout) :: b(ldb,*)
end subroutine strmm
#else
module procedure stdlib${ii}$_strmm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
complex(dp), intent(inout) :: b(ldb,*)
end subroutine ztrmm
#else
module procedure stdlib${ii}$_ztrmm
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$trmm
#:endif
#:endfor
#:endfor
end interface trmm
interface trmv
!! TRMV performs one of the matrix-vector operations
!! x := A*x, or x := A**T*x, or x := A**H*x,
!! where x is an n element vector and A is an n by n unit, or non-unit,
!! upper or lower triangular matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctrmv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: x(*)
end subroutine ctrmv
#else
module procedure stdlib${ii}$_ctrmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtrmv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: a(lda,*)
real(dp), intent(inout) :: x(*)
end subroutine dtrmv
#else
module procedure stdlib${ii}$_dtrmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine strmv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: a(lda,*)
real(sp), intent(inout) :: x(*)
end subroutine strmv
#else
module procedure stdlib${ii}$_strmv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztrmv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: x(*)
end subroutine ztrmv
#else
module procedure stdlib${ii}$_ztrmv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$trmv
#:endif
#:endfor
#:endfor
end interface trmv
interface trsm
!! TRSM solves one of the matrix equations
!! op( A )*X = alpha*B, or X*op( A ) = alpha*B,
!! where alpha is a scalar, X and B are m by n matrices, A is a unit, or
!! non-unit, upper or lower triangular matrix and op( A ) is one of
!! op( A ) = A or op( A ) = A**T or op( A ) = A**H.
!! The matrix X is overwritten on B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(sp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
complex(sp), intent(inout) :: b(ldb,*)
end subroutine ctrsm
#else
module procedure stdlib${ii}$_ctrsm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(dp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
real(dp), intent(inout) :: b(ldb,*)
end subroutine dtrsm
#else
module procedure stdlib${ii}$_dtrsm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine strsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
real(sp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
real(sp), intent(inout) :: b(ldb,*)
end subroutine strsm
#else
module procedure stdlib${ii}$_strsm
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
complex(dp), intent(in) :: alpha,a(lda,*)
integer(${ik}$), intent(in) :: lda,ldb,m,n
character, intent(in) :: diag,side,transa,uplo
complex(dp), intent(inout) :: b(ldb,*)
end subroutine ztrsm
#else
module procedure stdlib${ii}$_ztrsm
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$trsm
#:endif
#:endfor
#:endfor
end interface trsm
interface trsv
!! TRSV solves one of the systems of equations
!! A*x = b, or A**T*x = b, or A**H*x = b,
!! where b and x are n element vectors and A is an n by n unit, or
!! non-unit, upper or lower triangular matrix.
!! No test for singularity or near-singularity is included in this
!! routine. Such tests must be performed before calling this routine.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ctrsv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: x(*)
end subroutine ctrsv
#else
module procedure stdlib${ii}$_ctrsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine dtrsv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
real(dp), intent(in) :: a(lda,*)
real(dp), intent(inout) :: x(*)
end subroutine dtrsv
#else
module procedure stdlib${ii}$_dtrsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine strsv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
real(sp), intent(in) :: a(lda,*)
real(sp), intent(inout) :: x(*)
end subroutine strsv
#else
module procedure stdlib${ii}$_strsv
#endif
#ifdef STDLIB_EXTERNAL_BLAS${ii}$
pure subroutine ztrsv(uplo,trans,diag,n,a,lda,x,incx)
import sp,dp,qp,${ik}$,lk
implicit none(type,external)
integer(${ik}$), intent(in) :: incx,lda,n
character, intent(in) :: diag,trans,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: x(*)
end subroutine ztrsv
#else
module procedure stdlib${ii}$_ztrsv
#endif
#:for rk,rt,ri in RC_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$trsv
#:endif
#:endfor
#:endfor
end interface trsv
end module stdlib_linalg_blas
