#:include "common.fypp"
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
module stdlib_linalg_lapack
use stdlib_linalg_constants
use stdlib_linalg_blas
use stdlib_linalg_lapack_aux
use stdlib_lapack_base
use stdlib_lapack_solve
use stdlib_lapack_others
use stdlib_lapack_orthogonal_factors
use stdlib_lapack_eig_svd_lsq
implicit none
public
interface bbcsd
!! BBCSD computes the CS decomposition of a unitary matrix in
!! bidiagonal-block form,
!! [ B11 | B12 0 0 ]
!! [ 0 | 0 -I 0 ]
!! X = [----------------]
!! [ B21 | B22 0 0 ]
!! [ 0 | 0 0 I ]
!! [ C | -S 0 0 ]
!!
!! [ U1 | ] [ 0 | 0 -I 0 ] [ V1 | ]**H
!! = [---------] [---------------] [---------] .
!! [ | U2 ] [ S | C 0 0 ] [ | V2 ]
!! [ 0 | 0 0 I ]
!! X is M-by-M, its top-left block is P-by-Q, and Q must be no larger
!! than P, M-P, or M-Q. (If Q is not the smallest index, then X must be
!! transposed and/or permuted. This can be done in constant time using
!! the TRANS and SIGNS options. See CUNCSD for details.)
!! The bidiagonal matrices B11, B12, B21, and B22 are represented
!! implicitly by angles THETA(1:Q) and PHI(1:Q-1).
!! The unitary matrices U1, U2, V1T, and V2T are input/output.
!! The input matrices are pre- or post-multiplied by the appropriate
!! singular vector matrices.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#:for rk,rt,ri in RC_KINDS_TYPES
#:if rk in ["sp","dp"]
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine ${ri}$bbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, &
u1, ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d,&
b22e, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobu1,jobu2,jobv1t,jobv2t,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldu1,ldu2,ldv1t,ldv2t,lrwork,m,p,q
real(${rk}$), intent(out) :: b11d(*),b11e(*),b12d(*),b12e(*),b21d(*),b21e(*),&
b22d(*),b22e(*),rwork(*)
real(${rk}$), intent(inout) :: phi(*),theta(*)
${rt}$, intent(inout) :: u1(ldu1,*),u2(ldu2,*),v1t(ldv1t,*),v2t(ldv2t,*)
end subroutine ${ri}$bbcsd
#else
#:endif
module procedure stdlib${ii}$_${ri}$bbcsd
#:if rk in ["sp","dp"]
#endif
#:endif
#:endfor
#:endfor
end interface bbcsd
interface bdsdc
!! BDSDC computes the singular value decomposition (SVD) of a real
!! N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
!! using a divide and conquer method, where S is a diagonal matrix
!! with non-negative diagonal elements (the singular values of B), and
!! U and VT are orthogonal matrices of left and right singular vectors,
!! respectively. BDSDC can be used to compute all singular values,
!! and optionally, singular vectors or singular vectors in compact form.
!! This code makes very mild assumptions about floating point
!! arithmetic. It will work on machines with a guard digit in
!! add/subtract, or on those binary machines without guard digits
!! which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
!! It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none. See DLASD3 for details.
!! The code currently calls DLASDQ if singular values only are desired.
!! However, it can be slightly modified to compute singular values
!! using the divide and conquer method.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,uplo
integer(${ik}$), intent(out) :: info,iq(*),iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,n
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: q(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine dbdsdc
#else
module procedure stdlib${ii}$_dbdsdc
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,uplo
integer(${ik}$), intent(out) :: info,iq(*),iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,n
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: q(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine sbdsdc
#else
module procedure stdlib${ii}$_sbdsdc
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$bdsdc
#:endif
#:endfor
#:endfor
end interface bdsdc
interface bdsqr
!! BDSQR computes the singular values and, optionally, the right and/or
!! left singular vectors from the singular value decomposition (SVD) of
!! a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
!! zero-shift QR algorithm. The SVD of B has the form
!! B = Q * S * P**H
!! where S is the diagonal matrix of singular values, Q is an orthogonal
!! matrix of left singular vectors, and P is an orthogonal matrix of
!! right singular vectors. If left singular vectors are requested, this
!! subroutine actually returns U*Q instead of Q, and, if right singular
!! vectors are requested, this subroutine returns P**H*VT instead of
!! P**H, for given complex input matrices U and VT. When U and VT are
!! the unitary matrices that reduce a general matrix A to bidiagonal
!! form: A = U*B*VT, as computed by CGEBRD, then
!! A = (U*Q) * S * (P**H*VT)
!! is the SVD of A. Optionally, the subroutine may also compute Q**H*C
!! for a given complex input matrix C.
!! See "Computing Small Singular Values of Bidiagonal Matrices With
!! Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
!! LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
!! no. 5, pp. 873-912, Sept 1990) and
!! "Accurate singular values and differential qd algorithms," by
!! B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
!! Department, University of California at Berkeley, July 1992
!! for a detailed description of the algorithm.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: c(ldc,*),u(ldu,*),vt(ldvt,*)
end subroutine cbdsqr
#else
module procedure stdlib${ii}$_cbdsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, &
work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru
real(dp), intent(inout) :: c(ldc,*),d(*),e(*),u(ldu,*),vt(ldvt,*)
real(dp), intent(out) :: work(*)
end subroutine dbdsqr
#else
module procedure stdlib${ii}$_dbdsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, &
work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru
real(sp), intent(inout) :: c(ldc,*),d(*),e(*),u(ldu,*),vt(ldvt,*)
real(sp), intent(out) :: work(*)
end subroutine sbdsqr
#else
module procedure stdlib${ii}$_sbdsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: c(ldc,*),u(ldu,*),vt(ldvt,*)
end subroutine zbdsqr
#else
module procedure stdlib${ii}$_zbdsqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$bdsqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$bdsqr
#:endif
#:endfor
#:endfor
end interface bdsqr
interface disna
!! DISNA computes the reciprocal condition numbers for the eigenvectors
!! of a real symmetric or complex Hermitian matrix or for the left or
!! right singular vectors of a general m-by-n matrix. The reciprocal
!! condition number is the 'gap' between the corresponding eigenvalue or
!! singular value and the nearest other one.
!! The bound on the error, measured by angle in radians, in the I-th
!! computed vector is given by
!! DLAMCH( 'E' ) * ( ANORM / SEP( I ) )
!! where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
!! to be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of
!! the error bound.
!! DISNA may also be used to compute error bounds for eigenvectors of
!! the generalized symmetric definite eigenproblem.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine ddisna( job, m, n, d, sep, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: m,n
real(dp), intent(in) :: d(*)
real(dp), intent(out) :: sep(*)
end subroutine ddisna
#else
module procedure stdlib${ii}$_ddisna
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sdisna( job, m, n, d, sep, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: m,n
real(sp), intent(in) :: d(*)
real(sp), intent(out) :: sep(*)
end subroutine sdisna
#else
module procedure stdlib${ii}$_sdisna
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$disna
#:endif
#:endfor
#:endfor
end interface disna
interface gbbrd
!! GBBRD reduces a complex general m-by-n band matrix A to real upper
!! bidiagonal form B by a unitary transformation: Q**H * A * P = B.
!! The routine computes B, and optionally forms Q or P**H, or computes
!! Q**H*C for a given matrix C.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, &
c, ldc, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldc,ldpt,ldq,m,n,ncc
real(sp), intent(out) :: d(*),e(*),rwork(*)
complex(sp), intent(inout) :: ab(ldab,*),c(ldc,*)
complex(sp), intent(out) :: pt(ldpt,*),q(ldq,*),work(*)
end subroutine cgbbrd
#else
module procedure stdlib${ii}$_cgbbrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, &
c, ldc, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldc,ldpt,ldq,m,n,ncc
real(dp), intent(inout) :: ab(ldab,*),c(ldc,*)
real(dp), intent(out) :: d(*),e(*),pt(ldpt,*),q(ldq,*),work(*)
end subroutine dgbbrd
#else
module procedure stdlib${ii}$_dgbbrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, &
c, ldc, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldc,ldpt,ldq,m,n,ncc
real(sp), intent(inout) :: ab(ldab,*),c(ldc,*)
real(sp), intent(out) :: d(*),e(*),pt(ldpt,*),q(ldq,*),work(*)
end subroutine sgbbrd
#else
module procedure stdlib${ii}$_sgbbrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, &
c, ldc, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldc,ldpt,ldq,m,n,ncc
real(dp), intent(out) :: d(*),e(*),rwork(*)
complex(dp), intent(inout) :: ab(ldab,*),c(ldc,*)
complex(dp), intent(out) :: pt(ldpt,*),q(ldq,*),work(*)
end subroutine zgbbrd
#else
module procedure stdlib${ii}$_zgbbrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbbrd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbbrd
#:endif
#:endfor
#:endfor
end interface gbbrd
interface gbcon
!! GBCON estimates the reciprocal of the condition number of a complex
!! general band matrix A, in either the 1-norm or the infinity-norm,
!! using the LU factorization computed by CGBTRF.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as
!! RCOND = 1 / ( norm(A) * norm(inv(A)) ).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,n,ipiv(*)
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond,rwork(*)
complex(sp), intent(in) :: ab(ldab,*)
complex(sp), intent(out) :: work(*)
end subroutine cgbcon
#else
module procedure stdlib${ii}$_cgbcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,n,ipiv(*)
real(dp), intent(in) :: anorm,ab(ldab,*)
real(dp), intent(out) :: rcond,work(*)
end subroutine dgbcon
#else
module procedure stdlib${ii}$_dgbcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,n,ipiv(*)
real(sp), intent(in) :: anorm,ab(ldab,*)
real(sp), intent(out) :: rcond,work(*)
end subroutine sgbcon
#else
module procedure stdlib${ii}$_sgbcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,n,ipiv(*)
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond,rwork(*)
complex(dp), intent(in) :: ab(ldab,*)
complex(dp), intent(out) :: work(*)
end subroutine zgbcon
#else
module procedure stdlib${ii}$_zgbcon
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbcon
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbcon
#:endif
#:endfor
#:endfor
end interface gbcon
interface gbequ
!! GBEQU computes row and column scalings intended to equilibrate an
!! M-by-N band matrix A and reduce its condition number. R returns the
!! row scale factors and C the column scale factors, chosen to try to
!! make the largest element in each row and column of the matrix B with
!! elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
!! R(i) and C(j) are restricted to be between SMLNUM = smallest safe
!! number and BIGNUM = largest safe number. Use of these scaling
!! factors is not guaranteed to reduce the condition number of A but
!! works well in practice.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(in) :: ab(ldab,*)
end subroutine cgbequ
#else
module procedure stdlib${ii}$_cgbequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(in) :: ab(ldab,*)
end subroutine dgbequ
#else
module procedure stdlib${ii}$_dgbequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(in) :: ab(ldab,*)
end subroutine sgbequ
#else
module procedure stdlib${ii}$_sgbequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(in) :: ab(ldab,*)
end subroutine zgbequ
#else
module procedure stdlib${ii}$_zgbequ
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbequ
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbequ
#:endif
#:endfor
#:endfor
end interface gbequ
interface gbequb
!! GBEQUB computes row and column scalings intended to equilibrate an
!! M-by-N matrix A and reduce its condition number. R returns the row
!! scale factors and C the column scale factors, chosen to try to make
!! the largest element in each row and column of the matrix B with
!! elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
!! the radix.
!! R(i) and C(j) are restricted to be a power of the radix between
!! SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
!! of these scaling factors is not guaranteed to reduce the condition
!! number of A but works well in practice.
!! This routine differs from CGEEQU by restricting the scaling factors
!! to a power of the radix. Barring over- and underflow, scaling by
!! these factors introduces no additional rounding errors. However, the
!! scaled entries' magnitudes are no longer approximately 1 but lie
!! between sqrt(radix) and 1/sqrt(radix).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(in) :: ab(ldab,*)
end subroutine cgbequb
#else
module procedure stdlib${ii}$_cgbequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(in) :: ab(ldab,*)
end subroutine dgbequb
#else
module procedure stdlib${ii}$_dgbequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(in) :: ab(ldab,*)
end subroutine sgbequb
#else
module procedure stdlib${ii}$_sgbequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(in) :: ab(ldab,*)
end subroutine zgbequb
#else
module procedure stdlib${ii}$_zgbequb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbequb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbequb
#:endif
#:endfor
#:endfor
end interface gbequb
interface gbrfs
!! GBRFS improves the computed solution to a system of linear
!! equations when the coefficient matrix is banded, and provides
!! error bounds and backward error estimates for the solution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, &
x, ldx, ferr, berr, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldafb,ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(sp), intent(in) :: ab(ldab,*),afb(ldafb,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine cgbrfs
#else
module procedure stdlib${ii}$_cgbrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, &
x, ldx, ferr, berr, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldafb,ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(in) :: ab(ldab,*),afb(ldafb,*),b(ldb,*)
real(dp), intent(out) :: berr(*),ferr(*),work(*)
real(dp), intent(inout) :: x(ldx,*)
end subroutine dgbrfs
#else
module procedure stdlib${ii}$_dgbrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, &
x, ldx, ferr, berr, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldafb,ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(in) :: ab(ldab,*),afb(ldafb,*),b(ldb,*)
real(sp), intent(out) :: berr(*),ferr(*),work(*)
real(sp), intent(inout) :: x(ldx,*)
end subroutine sgbrfs
#else
module procedure stdlib${ii}$_sgbrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, &
x, ldx, ferr, berr, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldafb,ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(dp), intent(in) :: ab(ldab,*),afb(ldafb,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zgbrfs
#else
module procedure stdlib${ii}$_zgbrfs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbrfs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbrfs
#:endif
#:endfor
#:endfor
end interface gbrfs
interface gbsv
!! GBSV computes the solution to a complex system of linear equations
!! A * X = B, where A is a band matrix of order N with KL subdiagonals
!! and KU superdiagonals, and X and B are N-by-NRHS matrices.
!! The LU decomposition with partial pivoting and row interchanges is
!! used to factor A as A = L * U, where L is a product of permutation
!! and unit lower triangular matrices with KL subdiagonals, and U is
!! upper triangular with KL+KU superdiagonals. The factored form of A
!! is then used to solve the system of equations A * X = B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs
complex(sp), intent(inout) :: ab(ldab,*),b(ldb,*)
end subroutine cgbsv
#else
module procedure stdlib${ii}$_cgbsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs
real(dp), intent(inout) :: ab(ldab,*),b(ldb,*)
end subroutine dgbsv
#else
module procedure stdlib${ii}$_dgbsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs
real(sp), intent(inout) :: ab(ldab,*),b(ldb,*)
end subroutine sgbsv
#else
module procedure stdlib${ii}$_sgbsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs
complex(dp), intent(inout) :: ab(ldab,*),b(ldb,*)
end subroutine zgbsv
#else
module procedure stdlib${ii}$_zgbsv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbsv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbsv
#:endif
#:endfor
#:endfor
end interface gbsv
interface gbtrf
!! GBTRF computes an LU factorization of a complex m-by-n band matrix A
!! using partial pivoting with row interchanges.
!! This is the blocked version of the algorithm, calling Level 3 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbtrf( m, n, kl, ku, ab, ldab, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
complex(sp), intent(inout) :: ab(ldab,*)
end subroutine cgbtrf
#else
module procedure stdlib${ii}$_cgbtrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbtrf( m, n, kl, ku, ab, ldab, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(inout) :: ab(ldab,*)
end subroutine dgbtrf
#else
module procedure stdlib${ii}$_dgbtrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbtrf( m, n, kl, ku, ab, ldab, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(inout) :: ab(ldab,*)
end subroutine sgbtrf
#else
module procedure stdlib${ii}$_sgbtrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbtrf( m, n, kl, ku, ab, ldab, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
complex(dp), intent(inout) :: ab(ldab,*)
end subroutine zgbtrf
#else
module procedure stdlib${ii}$_zgbtrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbtrf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbtrf
#:endif
#:endfor
#:endfor
end interface gbtrf
interface gbtrs
!! GBTRS solves a system of linear equations
!! A * X = B, A**T * X = B, or A**H * X = B
!! with a general band matrix A using the LU factorization computed
!! by CGBTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: ab(ldab,*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine cgbtrs
#else
module procedure stdlib${ii}$_cgbtrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs,ipiv(*)
real(dp), intent(in) :: ab(ldab,*)
real(dp), intent(inout) :: b(ldb,*)
end subroutine dgbtrs
#else
module procedure stdlib${ii}$_dgbtrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs,ipiv(*)
real(sp), intent(in) :: ab(ldab,*)
real(sp), intent(inout) :: b(ldb,*)
end subroutine sgbtrs
#else
module procedure stdlib${ii}$_sgbtrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,ldab,ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: ab(ldab,*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zgbtrs
#else
module procedure stdlib${ii}$_zgbtrs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbtrs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gbtrs
#:endif
#:endfor
#:endfor
end interface gbtrs
interface gebak
!! GEBAK forms the right or left eigenvectors of a complex general
!! matrix by backward transformation on the computed eigenvectors of the
!! balanced matrix output by CGEBAL.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: scale(*)
complex(sp), intent(inout) :: v(ldv,*)
end subroutine cgebak
#else
module procedure stdlib${ii}$_cgebak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: scale(*)
real(dp), intent(inout) :: v(ldv,*)
end subroutine dgebak
#else
module procedure stdlib${ii}$_dgebak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(sp), intent(inout) :: v(ldv,*)
real(sp), intent(in) :: scale(*)
end subroutine sgebak
#else
module procedure stdlib${ii}$_sgebak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: scale(*)
complex(dp), intent(inout) :: v(ldv,*)
end subroutine zgebak
#else
module procedure stdlib${ii}$_zgebak
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebak
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebak
#:endif
#:endfor
#:endfor
end interface gebak
interface gebal
!! GEBAL balances a general complex matrix A. This involves, first,
!! permuting A by a similarity transformation to isolate eigenvalues
!! in the first 1 to ILO-1 and last IHI+1 to N elements on the
!! diagonal; and second, applying a diagonal similarity transformation
!! to rows and columns ILO to IHI to make the rows and columns as
!! close in norm as possible. Both steps are optional.
!! Balancing may reduce the 1-norm of the matrix, and improve the
!! accuracy of the computed eigenvalues and/or eigenvectors.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgebal( job, n, a, lda, ilo, ihi, scale, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(out) :: scale(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine cgebal
#else
module procedure stdlib${ii}$_cgebal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgebal( job, n, a, lda, ilo, ihi, scale, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: scale(*)
end subroutine dgebal
#else
module procedure stdlib${ii}$_dgebal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgebal( job, n, a, lda, ilo, ihi, scale, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: scale(*)
end subroutine sgebal
#else
module procedure stdlib${ii}$_sgebal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgebal( job, n, a, lda, ilo, ihi, scale, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(out) :: scale(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zgebal
#else
module procedure stdlib${ii}$_zgebal
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebal
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebal
#:endif
#:endfor
#:endfor
end interface gebal
interface gebrd
!! GEBRD reduces a general complex M-by-N matrix A to upper or lower
!! bidiagonal form B by a unitary transformation: Q**H * A * P = B.
!! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: taup(*),tauq(*),work(*)
end subroutine cgebrd
#else
module procedure stdlib${ii}$_cgebrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: d(*),e(*),taup(*),tauq(*),work(*)
end subroutine dgebrd
#else
module procedure stdlib${ii}$_dgebrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: d(*),e(*),taup(*),tauq(*),work(*)
end subroutine sgebrd
#else
module procedure stdlib${ii}$_sgebrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: taup(*),tauq(*),work(*)
end subroutine zgebrd
#else
module procedure stdlib${ii}$_zgebrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebrd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gebrd
#:endif
#:endfor
#:endfor
end interface gebrd
interface gecon
!! GECON estimates the reciprocal of the condition number of a general
!! complex matrix A, in either the 1-norm or the infinity-norm, using
!! the LU factorization computed by CGETRF.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as
!! RCOND = 1 / ( norm(A) * norm(inv(A)) ).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond,rwork(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine cgecon
#else
module procedure stdlib${ii}$_cgecon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgecon( norm, n, a, lda, anorm, rcond, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond,work(*)
real(dp), intent(inout) :: a(lda,*)
end subroutine dgecon
#else
module procedure stdlib${ii}$_dgecon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgecon( norm, n, a, lda, anorm, rcond, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond,work(*)
real(sp), intent(inout) :: a(lda,*)
end subroutine sgecon
#else
module procedure stdlib${ii}$_sgecon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgecon( norm, n, a, lda, anorm, rcond, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond,rwork(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zgecon
#else
module procedure stdlib${ii}$_zgecon
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gecon
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gecon
#:endif
#:endfor
#:endfor
end interface gecon
interface geequ
!! GEEQU computes row and column scalings intended to equilibrate an
!! M-by-N matrix A and reduce its condition number. R returns the row
!! scale factors and C the column scale factors, chosen to try to make
!! the largest element in each row and column of the matrix B with
!! elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
!! R(i) and C(j) are restricted to be between SMLNUM = smallest safe
!! number and BIGNUM = largest safe number. Use of these scaling
!! factors is not guaranteed to reduce the condition number of A but
!! works well in practice.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(in) :: a(lda,*)
end subroutine cgeequ
#else
module procedure stdlib${ii}$_cgeequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(in) :: a(lda,*)
end subroutine dgeequ
#else
module procedure stdlib${ii}$_dgeequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(in) :: a(lda,*)
end subroutine sgeequ
#else
module procedure stdlib${ii}$_sgeequ
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(in) :: a(lda,*)
end subroutine zgeequ
#else
module procedure stdlib${ii}$_zgeequ
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geequ
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geequ
#:endif
#:endfor
#:endfor
end interface geequ
interface geequb
!! GEEQUB computes row and column scalings intended to equilibrate an
!! M-by-N matrix A and reduce its condition number. R returns the row
!! scale factors and C the column scale factors, chosen to try to make
!! the largest element in each row and column of the matrix B with
!! elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
!! the radix.
!! R(i) and C(j) are restricted to be a power of the radix between
!! SMLNUM = smallest safe number and BIGNUM = largest safe number. Use
!! of these scaling factors is not guaranteed to reduce the condition
!! number of A but works well in practice.
!! This routine differs from CGEEQU by restricting the scaling factors
!! to a power of the radix. Barring over- and underflow, scaling by
!! these factors introduces no additional rounding errors. However, the
!! scaled entries' magnitudes are no longer approximately 1 but lie
!! between sqrt(radix) and 1/sqrt(radix).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(in) :: a(lda,*)
end subroutine cgeequb
#else
module procedure stdlib${ii}$_cgeequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(in) :: a(lda,*)
end subroutine dgeequb
#else
module procedure stdlib${ii}$_dgeequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(in) :: a(lda,*)
end subroutine sgeequb
#else
module procedure stdlib${ii}$_sgeequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(in) :: a(lda,*)
end subroutine zgeequb
#else
module procedure stdlib${ii}$_zgeequb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geequb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geequb
#:endif
#:endfor
#:endfor
end interface geequb
interface gees
!! GEES computes for an N-by-N complex nonsymmetric matrix A, the
!! eigenvalues, the Schur form T, and, optionally, the matrix of Schur
!! vectors Z. This gives the Schur factorization A = Z*T*(Z**H).
!! Optionally, it also orders the eigenvalues on the diagonal of the
!! Schur form so that selected eigenvalues are at the top left.
!! The leading columns of Z then form an orthonormal basis for the
!! invariant subspace corresponding to the selected eigenvalues.
!! A complex matrix is in Schur form if it is upper triangular.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, &
rwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_select_c
implicit none
character, intent(in) :: jobvs,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldvs,lwork,n
logical(lk), intent(out) :: bwork(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: vs(ldvs,*),w(*),work(*)
procedure(stdlib_select_c) :: select
end subroutine cgees
#else
module procedure stdlib${ii}$_cgees
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, &
lwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_select_d
implicit none
character, intent(in) :: jobvs,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldvs,lwork,n
logical(lk), intent(out) :: bwork(*)
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: vs(ldvs,*),wi(*),work(*),wr(*)
procedure(stdlib_select_d) :: select
end subroutine dgees
#else
module procedure stdlib${ii}$_dgees
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, &
lwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_select_s
implicit none
character, intent(in) :: jobvs,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldvs,lwork,n
logical(lk), intent(out) :: bwork(*)
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: vs(ldvs,*),wi(*),work(*),wr(*)
procedure(stdlib_select_s) :: select
end subroutine sgees
#else
module procedure stdlib${ii}$_sgees
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, &
rwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_select_z
implicit none
character, intent(in) :: jobvs,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldvs,lwork,n
logical(lk), intent(out) :: bwork(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: vs(ldvs,*),w(*),work(*)
procedure(stdlib_select_z) :: select
end subroutine zgees
#else
module procedure stdlib${ii}$_zgees
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gees
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gees
#:endif
#:endfor
#:endfor
end interface gees
interface geev
!! GEEV computes for an N-by-N complex nonsymmetric matrix A, the
!! eigenvalues and, optionally, the left and/or right eigenvectors.
!! The right eigenvector v(j) of A satisfies
!! A * v(j) = lambda(j) * v(j)
!! where lambda(j) is its eigenvalue.
!! The left eigenvector u(j) of A satisfies
!! u(j)**H * A = lambda(j) * u(j)**H
!! where u(j)**H denotes the conjugate transpose of u(j).
!! The computed eigenvectors are normalized to have Euclidean norm
!! equal to 1 and largest component real.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldvl,ldvr,lwork,n
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: vl(ldvl,*),vr(ldvr,*),w(*),work(*)
end subroutine cgeev
#else
module procedure stdlib${ii}$_cgeev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldvl,ldvr,lwork,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: vl(ldvl,*),vr(ldvr,*),wi(*),work(*),wr(*)
end subroutine dgeev
#else
module procedure stdlib${ii}$_dgeev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldvl,ldvr,lwork,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: vl(ldvl,*),vr(ldvr,*),wi(*),work(*),wr(*)
end subroutine sgeev
#else
module procedure stdlib${ii}$_sgeev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldvl,ldvr,lwork,n
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: vl(ldvl,*),vr(ldvr,*),w(*),work(*)
end subroutine zgeev
#else
module procedure stdlib${ii}$_zgeev
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geev
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geev
#:endif
#:endfor
#:endfor
end interface geev
interface gehrd
!! GEHRD reduces a complex general matrix A to upper Hessenberg form H by
!! an unitary similarity transformation: Q**H * A * Q = H .
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,lda,lwork,n
integer(${ik}$), intent(out) :: info
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgehrd
#else
module procedure stdlib${ii}$_cgehrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,lda,lwork,n
integer(${ik}$), intent(out) :: info
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgehrd
#else
module procedure stdlib${ii}$_dgehrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,lda,lwork,n
integer(${ik}$), intent(out) :: info
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgehrd
#else
module procedure stdlib${ii}$_sgehrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,lda,lwork,n
integer(${ik}$), intent(out) :: info
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgehrd
#else
module procedure stdlib${ii}$_zgehrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gehrd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gehrd
#:endif
#:endfor
#:endfor
end interface gehrd
interface gejsv
!! GEJSV computes the singular value decomposition (SVD) of a complex M-by-N
!! matrix [A], where M >= N. The SVD of [A] is written as
!! [A] = [U] * [SIGMA] * [V]^*,
!! where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N
!! diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and
!! [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are
!! the singular values of [A]. The columns of [U] and [V] are the left and
!! the right singular vectors of [A], respectively. The matrices [U] and [V]
!! are computed and stored in the arrays U and V, respectively. The diagonal
!! of [SIGMA] is computed and stored in the array SVA.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, &
ldu, v, ldv,cwork, lwork, rwork, lrwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldv,lwork,lrwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: u(ldu,*),v(ldv,*),cwork(lwork)
real(sp), intent(out) :: sva(n),rwork(lrwork)
character, intent(in) :: joba,jobp,jobr,jobt,jobu,jobv
end subroutine cgejsv
#else
module procedure stdlib${ii}$_cgejsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, &
ldu, v, ldv,work, lwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldv,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: sva(n),u(ldu,*),v(ldv,*),work(lwork)
character, intent(in) :: joba,jobp,jobr,jobt,jobu,jobv
end subroutine dgejsv
#else
module procedure stdlib${ii}$_dgejsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, &
ldu, v, ldv,work, lwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldv,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: sva(n),u(ldu,*),v(ldv,*),work(lwork)
character, intent(in) :: joba,jobp,jobr,jobt,jobu,jobv
end subroutine sgejsv
#else
module procedure stdlib${ii}$_sgejsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, &
ldu, v, ldv,cwork, lwork, rwork, lrwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldv,lwork,lrwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: u(ldu,*),v(ldv,*),cwork(lwork)
real(dp), intent(out) :: sva(n),rwork(lrwork)
character, intent(in) :: joba,jobp,jobr,jobt,jobu,jobv
end subroutine zgejsv
#else
module procedure stdlib${ii}$_zgejsv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gejsv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gejsv
#:endif
#:endfor
#:endfor
end interface gejsv
interface gelq
!! GELQ computes an LQ factorization of a complex M-by-N matrix A:
!! A = ( L 0 ) * Q
!! where:
!! Q is a N-by-N orthogonal matrix;
!! L is a lower-triangular M-by-M matrix;
!! 0 is a M-by-(N-M) zero matrix, if M < N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgelq( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(*),work(*)
end subroutine cgelq
#else
module procedure stdlib${ii}$_cgelq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgelq( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(*),work(*)
end subroutine dgelq
#else
module procedure stdlib${ii}$_dgelq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgelq( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(*),work(*)
end subroutine sgelq
#else
module procedure stdlib${ii}$_sgelq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgelq( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(*),work(*)
end subroutine zgelq
#else
module procedure stdlib${ii}$_zgelq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelq
#:endif
#:endfor
#:endfor
end interface gelq
interface gelqf
!! GELQF computes an LQ factorization of a complex M-by-N matrix A:
!! A = ( L 0 ) * Q
!! where:
!! Q is a N-by-N orthogonal matrix;
!! L is a lower-triangular M-by-M matrix;
!! 0 is a M-by-(N-M) zero matrix, if M < N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgelqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgelqf
#else
module procedure stdlib${ii}$_cgelqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgelqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgelqf
#else
module procedure stdlib${ii}$_dgelqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgelqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgelqf
#else
module procedure stdlib${ii}$_sgelqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgelqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgelqf
#else
module procedure stdlib${ii}$_zgelqf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqf
#:endif
#:endfor
#:endfor
end interface gelqf
interface gelqt
!! GELQT computes a blocked LQ factorization of a complex M-by-N matrix A
!! using the compact WY representation of Q.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgelqt( m, n, mb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,mb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*),work(*)
end subroutine cgelqt
#else
module procedure stdlib${ii}$_cgelqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgelqt( m, n, mb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,mb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*),work(*)
end subroutine dgelqt
#else
module procedure stdlib${ii}$_dgelqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgelqt( m, n, mb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,mb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*),work(*)
end subroutine sgelqt
#else
module procedure stdlib${ii}$_sgelqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgelqt( m, n, mb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,mb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*),work(*)
end subroutine zgelqt
#else
module procedure stdlib${ii}$_zgelqt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqt
#:endif
#:endfor
#:endfor
end interface gelqt
interface gelqt3
!! GELQT3 recursively computes a LQ factorization of a complex M-by-N
!! matrix A, using the compact WY representation of Q.
!! Based on the algorithm of Elmroth and Gustavson,
!! IBM J. Res. Develop. Vol 44 No. 4 July 2000.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine cgelqt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*)
end subroutine cgelqt3
#else
module procedure stdlib${ii}$_cgelqt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine dgelqt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*)
end subroutine dgelqt3
#else
module procedure stdlib${ii}$_dgelqt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine sgelqt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*)
end subroutine sgelqt3
#else
module procedure stdlib${ii}$_sgelqt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine zgelqt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*)
end subroutine zgelqt3
#else
module procedure stdlib${ii}$_zgelqt3
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqt3
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelqt3
#:endif
#:endfor
#:endfor
end interface gelqt3
interface gels
!! GELS solves overdetermined or underdetermined complex linear systems
!! involving an M-by-N matrix A, or its conjugate-transpose, using a QR
!! or LQ factorization of A. It is assumed that A has full rank.
!! The following options are provided:
!! 1. If TRANS = 'N' and m >= n: find the least squares solution of
!! an overdetermined system, i.e., solve the least squares problem
!! minimize || B - A*X ||.
!! 2. If TRANS = 'N' and m < n: find the minimum norm solution of
!! an underdetermined system A * X = B.
!! 3. If TRANS = 'C' and m >= n: find the minimum norm solution of
!! an underdetermined system A**H * X = B.
!! 4. If TRANS = 'C' and m < n: find the least squares solution of
!! an overdetermined system, i.e., solve the least squares problem
!! minimize || B - A**H * X ||.
!! Several right hand side vectors b and solution vectors x can be
!! handled in a single call; they are stored as the columns of the
!! M-by-NRHS right hand side matrix B and the N-by-NRHS solution
!! matrix X.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine cgels
#else
module procedure stdlib${ii}$_cgels
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: work(*)
end subroutine dgels
#else
module procedure stdlib${ii}$_dgels
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: work(*)
end subroutine sgels
#else
module procedure stdlib${ii}$_sgels
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zgels
#else
module procedure stdlib${ii}$_zgels
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gels
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gels
#:endif
#:endfor
#:endfor
end interface gels
interface gelsd
!! GELSD computes the minimum-norm solution to a real linear least
!! squares problem:
!! minimize 2-norm(| b - A*x |)
!! using the singular value decomposition (SVD) of A. A is an M-by-N
!! matrix which may be rank-deficient.
!! Several right hand side vectors b and solution vectors x can be
!! handled in a single call; they are stored as the columns of the
!! M-by-NRHS right hand side matrix B and the N-by-NRHS solution
!! matrix X.
!! The problem is solved in three steps:
!! (1) Reduce the coefficient matrix A to bidiagonal form with
!! Householder transformations, reducing the original problem
!! into a "bidiagonal least squares problem" (BLS)
!! (2) Solve the BLS using a divide and conquer approach.
!! (3) Apply back all the Householder transformations to solve
!! the original least squares problem.
!! The effective rank of A is determined by treating as zero those
!! singular values which are less than RCOND times the largest singular
!! value.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
real(sp), intent(out) :: rwork(*),s(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine cgelsd
#else
module procedure stdlib${ii}$_cgelsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: s(*),work(*)
end subroutine dgelsd
#else
module procedure stdlib${ii}$_dgelsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond,rank, work, lwork, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: s(*),work(*)
end subroutine sgelsd
#else
module procedure stdlib${ii}$_sgelsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
real(dp), intent(out) :: rwork(*),s(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zgelsd
#else
module procedure stdlib${ii}$_zgelsd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelsd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelsd
#:endif
#:endfor
#:endfor
end interface gelsd
interface gelss
!! GELSS computes the minimum norm solution to a complex linear
!! least squares problem:
!! Minimize 2-norm(| b - A*x |).
!! using the singular value decomposition (SVD) of A. A is an M-by-N
!! matrix which may be rank-deficient.
!! Several right hand side vectors b and solution vectors x can be
!! handled in a single call; they are stored as the columns of the
!! M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
!! X.
!! The effective rank of A is determined by treating as zero those
!! singular values which are less than RCOND times the largest singular
!! value.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
real(sp), intent(out) :: rwork(*),s(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine cgelss
#else
module procedure stdlib${ii}$_cgelss
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: s(*),work(*)
end subroutine dgelss
#else
module procedure stdlib${ii}$_dgelss
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: s(*),work(*)
end subroutine sgelss
#else
module procedure stdlib${ii}$_sgelss
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
real(dp), intent(out) :: rwork(*),s(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zgelss
#else
module procedure stdlib${ii}$_zgelss
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelss
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelss
#:endif
#:endfor
#:endfor
end interface gelss
interface gelsy
!! GELSY computes the minimum-norm solution to a complex linear least
!! squares problem:
!! minimize || A * X - B ||
!! using a complete orthogonal factorization of A. A is an M-by-N
!! matrix which may be rank-deficient.
!! Several right hand side vectors b and solution vectors x can be
!! handled in a single call; they are stored as the columns of the
!! M-by-NRHS right hand side matrix B and the N-by-NRHS solution
!! matrix X.
!! The routine first computes a QR factorization with column pivoting:
!! A * P = Q * [ R11 R12 ]
!! [ 0 R22 ]
!! with R11 defined as the largest leading submatrix whose estimated
!! condition number is less than 1/RCOND. The order of R11, RANK,
!! is the effective rank of A.
!! Then, R22 is considered to be negligible, and R12 is annihilated
!! by unitary transformations from the right, arriving at the
!! complete orthogonal factorization:
!! A * P = Q * [ T11 0 ] * Z
!! [ 0 0 ]
!! The minimum-norm solution is then
!! X = P * Z**H [ inv(T11)*Q1**H*B ]
!! [ 0 ]
!! where Q1 consists of the first RANK columns of Q.
!! This routine is basically identical to the original xGELSX except
!! three differences:
!! o The permutation of matrix B (the right hand side) is faster and
!! more simple.
!! o The call to the subroutine xGEQPF has been substituted by the
!! the call to the subroutine xGEQP3. This subroutine is a Blas-3
!! version of the QR factorization with column pivoting.
!! o Matrix B (the right hand side) is updated with Blas-3.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
integer(${ik}$), intent(inout) :: jpvt(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine cgelsy
#else
module procedure stdlib${ii}$_cgelsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
integer(${ik}$), intent(inout) :: jpvt(*)
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: work(*)
end subroutine dgelsy
#else
module procedure stdlib${ii}$_dgelsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(in) :: rcond
integer(${ik}$), intent(inout) :: jpvt(*)
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: work(*)
end subroutine sgelsy
#else
module procedure stdlib${ii}$_sgelsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,rank
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(in) :: rcond
integer(${ik}$), intent(inout) :: jpvt(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zgelsy
#else
module procedure stdlib${ii}$_zgelsy
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelsy
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gelsy
#:endif
#:endfor
#:endfor
end interface gelsy
interface gemlq
!! GEMLQ overwrites the general real M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q * C C * Q
!! TRANS = 'C': Q**H * C C * Q**H
!! where Q is a complex unitary matrix defined as the product
!! of blocked elementary reflectors computed by short wide
!! LQ factorization (CGELQ)
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
complex(sp), intent(in) :: a(lda,*),t(*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine cgemlq
#else
module procedure stdlib${ii}$_cgemlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
real(dp), intent(in) :: a(lda,*),t(*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dgemlq
#else
module procedure stdlib${ii}$_dgemlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
real(sp), intent(in) :: a(lda,*),t(*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine sgemlq
#else
module procedure stdlib${ii}$_sgemlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
complex(dp), intent(in) :: a(lda,*),t(*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zgemlq
#else
module procedure stdlib${ii}$_zgemlq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemlq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemlq
#:endif
#:endfor
#:endfor
end interface gemlq
interface gemlqt
!! GEMLQT overwrites the general complex M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q C C Q
!! TRANS = 'C': Q**H C C Q**H
!! where Q is a complex unitary matrix defined as the product of K
!! elementary reflectors:
!! Q = H(1) H(2) . . . H(K) = I - V T V**H
!! generated using the compact WY representation as returned by CGELQT.
!! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,mb,ldt
complex(sp), intent(in) :: v(ldv,*),t(ldt,*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine cgemlqt
#else
module procedure stdlib${ii}$_cgemlqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,mb,ldt
real(dp), intent(in) :: v(ldv,*),t(ldt,*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dgemlqt
#else
module procedure stdlib${ii}$_dgemlqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,mb,ldt
real(sp), intent(in) :: v(ldv,*),t(ldt,*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine sgemlqt
#else
module procedure stdlib${ii}$_sgemlqt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,mb,ldt
complex(dp), intent(in) :: v(ldv,*),t(ldt,*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zgemlqt
#else
module procedure stdlib${ii}$_zgemlqt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemlqt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemlqt
#:endif
#:endfor
#:endfor
end interface gemlqt
interface gemqr
!! GEMQR overwrites the general real M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q * C C * Q
!! TRANS = 'T': Q**H * C C * Q**H
!! where Q is a complex unitary matrix defined as the product
!! of blocked elementary reflectors computed by tall skinny
!! QR factorization (CGEQR)
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
complex(sp), intent(in) :: a(lda,*),t(*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine cgemqr
#else
module procedure stdlib${ii}$_cgemqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
real(dp), intent(in) :: a(lda,*),t(*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dgemqr
#else
module procedure stdlib${ii}$_dgemqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
real(sp), intent(in) :: a(lda,*),t(*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine sgemqr
#else
module procedure stdlib${ii}$_sgemqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,tsize,lwork,ldc
complex(dp), intent(in) :: a(lda,*),t(*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zgemqr
#else
module procedure stdlib${ii}$_zgemqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemqr
#:endif
#:endfor
#:endfor
end interface gemqr
interface gemqrt
!! GEMQRT overwrites the general complex M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q C C Q
!! TRANS = 'C': Q**H C C Q**H
!! where Q is a complex orthogonal matrix defined as the product of K
!! elementary reflectors:
!! Q = H(1) H(2) . . . H(K) = I - V T V**H
!! generated using the compact WY representation as returned by CGEQRT.
!! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,nb,ldt
complex(sp), intent(in) :: v(ldv,*),t(ldt,*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine cgemqrt
#else
module procedure stdlib${ii}$_cgemqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,nb,ldt
real(dp), intent(in) :: v(ldv,*),t(ldt,*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dgemqrt
#else
module procedure stdlib${ii}$_dgemqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,nb,ldt
real(sp), intent(in) :: v(ldv,*),t(ldt,*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine sgemqrt
#else
module procedure stdlib${ii}$_sgemqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,ldv,ldc,m,n,nb,ldt
complex(dp), intent(in) :: v(ldv,*),t(ldt,*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zgemqrt
#else
module procedure stdlib${ii}$_zgemqrt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemqrt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gemqrt
#:endif
#:endfor
#:endfor
end interface gemqrt
interface geqlf
!! GEQLF computes a QL factorization of a complex M-by-N matrix A:
!! A = Q * L.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeqlf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgeqlf
#else
module procedure stdlib${ii}$_cgeqlf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeqlf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgeqlf
#else
module procedure stdlib${ii}$_dgeqlf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeqlf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgeqlf
#else
module procedure stdlib${ii}$_sgeqlf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeqlf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgeqlf
#else
module procedure stdlib${ii}$_zgeqlf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqlf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqlf
#:endif
#:endfor
#:endfor
end interface geqlf
interface geqr
!! GEQR computes a QR factorization of a complex M-by-N matrix A:
!! A = Q * ( R ),
!! ( 0 )
!! where:
!! Q is a M-by-M orthogonal matrix;
!! R is an upper-triangular N-by-N matrix;
!! 0 is a (M-N)-by-N zero matrix, if M > N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeqr( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(*),work(*)
end subroutine cgeqr
#else
module procedure stdlib${ii}$_cgeqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeqr( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(*),work(*)
end subroutine dgeqr
#else
module procedure stdlib${ii}$_dgeqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeqr( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(*),work(*)
end subroutine sgeqr
#else
module procedure stdlib${ii}$_sgeqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeqr( m, n, a, lda, t, tsize, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,tsize,lwork
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(*),work(*)
end subroutine zgeqr
#else
module procedure stdlib${ii}$_zgeqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqr
#:endif
#:endfor
#:endfor
end interface geqr
interface geqr2p
!! GEQR2P computes a QR factorization of a complex m-by-n matrix A:
!! A = Q * ( R ),
!! ( 0 )
!! where:
!! Q is a m-by-m orthogonal matrix;
!! R is an upper-triangular n-by-n matrix with nonnegative diagonal
!! entries;
!! 0 is a (m-n)-by-n zero matrix, if m > n.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgeqr2p( m, n, a, lda, tau, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgeqr2p
#else
module procedure stdlib${ii}$_cgeqr2p
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgeqr2p( m, n, a, lda, tau, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgeqr2p
#else
module procedure stdlib${ii}$_dgeqr2p
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgeqr2p( m, n, a, lda, tau, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgeqr2p
#else
module procedure stdlib${ii}$_sgeqr2p
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgeqr2p( m, n, a, lda, tau, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgeqr2p
#else
module procedure stdlib${ii}$_zgeqr2p
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqr2p
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqr2p
#:endif
#:endfor
#:endfor
end interface geqr2p
interface geqrf
!! GEQRF computes a QR factorization of a complex M-by-N matrix A:
!! A = Q * ( R ),
!! ( 0 )
!! where:
!! Q is a M-by-M orthogonal matrix;
!! R is an upper-triangular N-by-N matrix;
!! 0 is a (M-N)-by-N zero matrix, if M > N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeqrf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgeqrf
#else
module procedure stdlib${ii}$_cgeqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeqrf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgeqrf
#else
module procedure stdlib${ii}$_dgeqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeqrf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgeqrf
#else
module procedure stdlib${ii}$_sgeqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeqrf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgeqrf
#else
module procedure stdlib${ii}$_zgeqrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrf
#:endif
#:endfor
#:endfor
end interface geqrf
interface geqrfp
!! CGEQR2P computes a QR factorization of a complex M-by-N matrix A:
!! A = Q * ( R ),
!! ( 0 )
!! where:
!! Q is a M-by-M orthogonal matrix;
!! R is an upper-triangular N-by-N matrix with nonnegative diagonal
!! entries;
!! 0 is a (M-N)-by-N zero matrix, if M > N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgeqrfp( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgeqrfp
#else
module procedure stdlib${ii}$_cgeqrfp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgeqrfp( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgeqrfp
#else
module procedure stdlib${ii}$_dgeqrfp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgeqrfp( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgeqrfp
#else
module procedure stdlib${ii}$_sgeqrfp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgeqrfp( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgeqrfp
#else
module procedure stdlib${ii}$_zgeqrfp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrfp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrfp
#:endif
#:endfor
#:endfor
end interface geqrfp
interface geqrt
!! GEQRT computes a blocked QR factorization of a complex M-by-N matrix A
!! using the compact WY representation of Q.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeqrt( m, n, nb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*),work(*)
end subroutine cgeqrt
#else
module procedure stdlib${ii}$_cgeqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeqrt( m, n, nb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,nb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*),work(*)
end subroutine dgeqrt
#else
module procedure stdlib${ii}$_dgeqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeqrt( m, n, nb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,nb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*),work(*)
end subroutine sgeqrt
#else
module procedure stdlib${ii}$_sgeqrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeqrt( m, n, nb, a, lda, t, ldt, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*),work(*)
end subroutine zgeqrt
#else
module procedure stdlib${ii}$_zgeqrt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt
#:endif
#:endfor
#:endfor
end interface geqrt
interface geqrt2
!! GEQRT2 computes a QR factorization of a complex M-by-N matrix A,
!! using the compact WY representation of Q.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgeqrt2( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*)
end subroutine cgeqrt2
#else
module procedure stdlib${ii}$_cgeqrt2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgeqrt2( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*)
end subroutine dgeqrt2
#else
module procedure stdlib${ii}$_dgeqrt2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgeqrt2( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*)
end subroutine sgeqrt2
#else
module procedure stdlib${ii}$_sgeqrt2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgeqrt2( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*)
end subroutine zgeqrt2
#else
module procedure stdlib${ii}$_zgeqrt2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt2
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt2
#:endif
#:endfor
#:endfor
end interface geqrt2
interface geqrt3
!! GEQRT3 recursively computes a QR factorization of a complex M-by-N matrix A,
!! using the compact WY representation of Q.
!! Based on the algorithm of Elmroth and Gustavson,
!! IBM J. Res. Develop. Vol 44 No. 4 July 2000.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine cgeqrt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*)
end subroutine cgeqrt3
#else
module procedure stdlib${ii}$_cgeqrt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine dgeqrt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*)
end subroutine dgeqrt3
#else
module procedure stdlib${ii}$_dgeqrt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine sgeqrt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*)
end subroutine sgeqrt3
#else
module procedure stdlib${ii}$_sgeqrt3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine zgeqrt3( m, n, a, lda, t, ldt, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,ldt
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*)
end subroutine zgeqrt3
#else
module procedure stdlib${ii}$_zgeqrt3
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt3
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$geqrt3
#:endif
#:endfor
#:endfor
end interface geqrt3
interface geqp3
!! GEQP3 computes a QR factorization with column pivoting of a real or complex
!! M-by-N matrix A:
!!
!! A * P = Q * R,
!!
!! where:
!! Q is an M-by-min(M, N) orthogonal matrix
!! R is an min(M, N)-by-N upper triangular matrix;
#:for ik, it, ii in LINALG_INT_KINDS_TYPES
#:for rk, rt, ri in RC_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
#:if rk in ["sp", "dp"]
#:if rt.startswith("real")
pure subroutine ${ri}$geqp3(m, n, a, lda, jpvt, tau, work, lwork, info)
import sp, dp, qp, ${ik}$, lk
implicit none
integer(${ik}$), intent(in) :: m, n, lda, lwork
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(inout) :: jpvt(*)
${rt}$, intent(inout) :: a(lda, *)
${rt}$, intent(out) :: tau(*), work(*)
end subroutine ${ri}$geqp3
#:else
pure subroutine ${ri}$geqp3(m, n, a, lda, jpvt, tau, work, lwork, rwork, info)
import sp, dp, qp, ${ik}$, lk
implicit none
integer(${ik}$), intent(in) :: m, n, lda, lwork
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(inout) :: jpvt(*)
${rt}$, intent(inout) :: a(lda, *)
${rt}$, intent(out) :: tau(*), work(*)
real(${rk}$), intent(out) :: rwork(*)
end subroutine ${ri}$geqp3
#:endif
#:else
module procedure stdlib${ii}$_${ri}$geqp3
#:endif
#else
module procedure stdlib${ii}$_${ri}$geqp3
#endif
#:endfor
#:endfor
end interface geqp3
interface gerfs
!! GERFS improves the computed solution to a system of linear
!! equations and provides error bounds and backward error estimates for
!! the solution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, &
ferr, berr, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(sp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine cgerfs
#else
module procedure stdlib${ii}$_cgerfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, &
ferr, berr, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
real(dp), intent(out) :: berr(*),ferr(*),work(*)
real(dp), intent(inout) :: x(ldx,*)
end subroutine dgerfs
#else
module procedure stdlib${ii}$_dgerfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, &
ferr, berr, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
real(sp), intent(out) :: berr(*),ferr(*),work(*)
real(sp), intent(inout) :: x(ldx,*)
end subroutine sgerfs
#else
module procedure stdlib${ii}$_sgerfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, &
ferr, berr, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(dp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zgerfs
#else
module procedure stdlib${ii}$_zgerfs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gerfs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gerfs
#:endif
#:endfor
#:endfor
end interface gerfs
interface gerqf
!! GERQF computes an RQ factorization of a complex M-by-N matrix A:
!! A = R * Q.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgerqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine cgerqf
#else
module procedure stdlib${ii}$_cgerqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgerqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: tau(*),work(*)
end subroutine dgerqf
#else
module procedure stdlib${ii}$_dgerqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgerqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: tau(*),work(*)
end subroutine sgerqf
#else
module procedure stdlib${ii}$_sgerqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgerqf( m, n, a, lda, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,m,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zgerqf
#else
module procedure stdlib${ii}$_zgerqf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gerqf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gerqf
#:endif
#:endfor
#:endfor
end interface gerqf
interface gesdd
!! GESDD computes the singular value decomposition (SVD) of a complex
!! M-by-N matrix A, optionally computing the left and/or right singular
!! vectors, by using divide-and-conquer method. The SVD is written
!! A = U * SIGMA * conjugate-transpose(V)
!! where SIGMA is an M-by-N matrix which is zero except for its
!! min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
!! V is an N-by-N unitary matrix. The diagonal elements of SIGMA
!! are the singular values of A; they are real and non-negative, and
!! are returned in descending order. The first min(m,n) columns of
!! U and V are the left and right singular vectors of A.
!! Note that the routine returns VT = V**H, not V.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(sp), intent(out) :: rwork(*),s(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine cgesdd
#else
module procedure stdlib${ii}$_cgesdd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: s(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine dgesdd
#else
module procedure stdlib${ii}$_dgesdd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: s(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine sgesdd
#else
module procedure stdlib${ii}$_sgesdd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(dp), intent(out) :: rwork(*),s(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine zgesdd
#else
module procedure stdlib${ii}$_zgesdd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesdd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesdd
#:endif
#:endfor
#:endfor
end interface gesdd
interface gesv
!! GESV computes the solution to a complex system of linear equations
!! A * X = B,
!! where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
!! The LU decomposition with partial pivoting and row interchanges is
!! used to factor A as
!! A = P * L * U,
!! where P is a permutation matrix, L is unit lower triangular, and U is
!! upper triangular. The factored form of A is then used to solve the
!! system of equations A * X = B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgesv( n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine cgesv
#else
module procedure stdlib${ii}$_cgesv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgesv( n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine dgesv
#else
module procedure stdlib${ii}$_dgesv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgesv( n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine sgesv
#else
module procedure stdlib${ii}$_sgesv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgesv( n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine zgesv
#else
module procedure stdlib${ii}$_zgesv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesv
#:endif
#:endfor
#:endfor
end interface gesv
interface gesvd
!! GESVD computes the singular value decomposition (SVD) of a complex
!! M-by-N matrix A, optionally computing the left and/or right singular
!! vectors. The SVD is written
!! A = U * SIGMA * conjugate-transpose(V)
!! where SIGMA is an M-by-N matrix which is zero except for its
!! min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
!! V is an N-by-N unitary matrix. The diagonal elements of SIGMA
!! are the singular values of A; they are real and non-negative, and
!! are returned in descending order. The first min(m,n) columns of
!! U and V are the left and right singular vectors of A.
!! Note that the routine returns V**H, not V.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobu,jobvt
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(sp), intent(out) :: rwork(*),s(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine cgesvd
#else
module procedure stdlib${ii}$_cgesvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobu,jobvt
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: s(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine dgesvd
#else
module procedure stdlib${ii}$_dgesvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobu,jobvt
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: s(*),u(ldu,*),vt(ldvt,*),work(*)
end subroutine sgesvd
#else
module procedure stdlib${ii}$_sgesvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobu,jobvt
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldu,ldvt,lwork,m,n
real(dp), intent(out) :: rwork(*),s(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine zgesvd
#else
module procedure stdlib${ii}$_zgesvd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvd
#:endif
#:endfor
#:endfor
end interface gesvd
interface gesvdq
!! GESVDQ computes the singular value decomposition (SVD) of a complex
!! M-by-N matrix A, where M >= N. The SVD of A is written as
!! [++] [xx] [x0] [xx]
!! A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx]
!! [++] [xx]
!! where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal
!! matrix, and V is an N-by-N unitary matrix. The diagonal elements
!! of SIGMA are the singular values of A. The columns of U and V are the
!! left and the right singular vectors of A, respectively.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, &
numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: joba,jobp,jobr,jobu,jobv
integer(${ik}$), intent(in) :: m,n,lda,ldu,ldv,liwork,lrwork
integer(${ik}$), intent(out) :: numrank,info,iwork(*)
integer(${ik}$), intent(inout) :: lcwork
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: u(ldu,*),v(ldv,*),cwork(*)
real(sp), intent(out) :: s(*),rwork(*)
end subroutine cgesvdq
#else
module procedure stdlib${ii}$_cgesvdq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, &
numrank, iwork, liwork,work, lwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: joba,jobp,jobr,jobu,jobv
integer(${ik}$), intent(in) :: m,n,lda,ldu,ldv,liwork,lrwork
integer(${ik}$), intent(out) :: numrank,info,iwork(*)
integer(${ik}$), intent(inout) :: lwork
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: u(ldu,*),v(ldv,*),work(*),s(*),rwork(*)
end subroutine dgesvdq
#else
module procedure stdlib${ii}$_dgesvdq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, &
numrank, iwork, liwork,work, lwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: joba,jobp,jobr,jobu,jobv
integer(${ik}$), intent(in) :: m,n,lda,ldu,ldv,liwork,lrwork
integer(${ik}$), intent(out) :: numrank,info,iwork(*)
integer(${ik}$), intent(inout) :: lwork
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: u(ldu,*),v(ldv,*),work(*),s(*),rwork(*)
end subroutine sgesvdq
#else
module procedure stdlib${ii}$_sgesvdq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, &
numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: joba,jobp,jobr,jobu,jobv
integer(${ik}$), intent(in) :: m,n,lda,ldu,ldv,liwork,lrwork
integer(${ik}$), intent(out) :: numrank,info,iwork(*)
integer(${ik}$), intent(inout) :: lcwork
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: u(ldu,*),v(ldv,*),cwork(*)
real(dp), intent(out) :: s(*),rwork(*)
end subroutine zgesvdq
#else
module procedure stdlib${ii}$_zgesvdq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvdq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvdq
#:endif
#:endfor
#:endfor
end interface gesvdq
interface gesvj
!! GESVJ computes the singular value decomposition (SVD) of a complex
!! M-by-N matrix A, where M >= N. The SVD of A is written as
!! [++] [xx] [x0] [xx]
!! A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx]
!! [++] [xx]
!! where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal
!! matrix, and V is an N-by-N unitary matrix. The diagonal elements
!! of SIGMA are the singular values of A. The columns of U and V are the
!! left and the right singular vectors of A, respectively.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, &
lwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,lrwork,m,mv,n
character, intent(in) :: joba,jobu,jobv
complex(sp), intent(inout) :: a(lda,*),v(ldv,*),cwork(lwork)
real(sp), intent(inout) :: rwork(lrwork)
real(sp), intent(out) :: sva(n)
end subroutine cgesvj
#else
module procedure stdlib${ii}$_cgesvj
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, &
lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n
character, intent(in) :: joba,jobu,jobv
real(dp), intent(inout) :: a(lda,*),v(ldv,*),work(lwork)
real(dp), intent(out) :: sva(n)
end subroutine dgesvj
#else
module procedure stdlib${ii}$_dgesvj
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, &
lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n
character, intent(in) :: joba,jobu,jobv
real(sp), intent(inout) :: a(lda,*),v(ldv,*),work(lwork)
real(sp), intent(out) :: sva(n)
end subroutine sgesvj
#else
module procedure stdlib${ii}$_sgesvj
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, &
lwork, rwork, lrwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,lrwork,m,mv,n
character, intent(in) :: joba,jobu,jobv
complex(dp), intent(inout) :: a(lda,*),v(ldv,*),cwork(lwork)
real(dp), intent(inout) :: rwork(lrwork)
real(dp), intent(out) :: sva(n)
end subroutine zgesvj
#else
module procedure stdlib${ii}$_zgesvj
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvj
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gesvj
#:endif
#:endfor
#:endfor
end interface gesvj
interface getrf
!! GETRF computes an LU factorization of a general M-by-N matrix A
!! using partial pivoting with row interchanges.
!! The factorization has the form
!! A = P * L * U
!! where P is a permutation matrix, L is lower triangular with unit
!! diagonal elements (lower trapezoidal if m > n), and U is upper
!! triangular (upper trapezoidal if m < n).
!! This is the right-looking Level 3 BLAS version of the algorithm.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgetrf( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
complex(sp), intent(inout) :: a(lda,*)
end subroutine cgetrf
#else
module procedure stdlib${ii}$_cgetrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgetrf( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
end subroutine dgetrf
#else
module procedure stdlib${ii}$_dgetrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgetrf( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
end subroutine sgetrf
#else
module procedure stdlib${ii}$_sgetrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgetrf( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
complex(dp), intent(inout) :: a(lda,*)
end subroutine zgetrf
#else
module procedure stdlib${ii}$_zgetrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrf
#:endif
#:endfor
#:endfor
end interface getrf
interface getrf2
!! GETRF2 computes an LU factorization of a general M-by-N matrix A
!! using partial pivoting with row interchanges.
!! The factorization has the form
!! A = P * L * U
!! where P is a permutation matrix, L is lower triangular with unit
!! diagonal elements (lower trapezoidal if m > n), and U is upper
!! triangular (upper trapezoidal if m < n).
!! This is the recursive version of the algorithm. It divides
!! the matrix into four submatrices:
!! [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2
!! A = [ -----|----- ] with n1 = min(m,n)/2
!! [ A21 | A22 ] n2 = n-n1
!! [ A11 ]
!! The subroutine calls itself to factor [ --- ],
!! [ A12 ]
!! [ A12 ]
!! do the swaps on [ --- ], solve A12, update A22,
!! [ A22 ]
!! then calls itself to factor A22 and do the swaps on A21.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine cgetrf2( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
complex(sp), intent(inout) :: a(lda,*)
end subroutine cgetrf2
#else
module procedure stdlib${ii}$_cgetrf2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine dgetrf2( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
end subroutine dgetrf2
#else
module procedure stdlib${ii}$_dgetrf2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine sgetrf2( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
end subroutine sgetrf2
#else
module procedure stdlib${ii}$_sgetrf2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine zgetrf2( m, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,m,n
complex(dp), intent(inout) :: a(lda,*)
end subroutine zgetrf2
#else
module procedure stdlib${ii}$_zgetrf2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrf2
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrf2
#:endif
#:endfor
#:endfor
end interface getrf2
interface getri
!! GETRI computes the inverse of a matrix using the LU factorization
!! computed by CGETRF.
!! This method inverts U and then computes inv(A) by solving the system
!! inv(A)*L = inv(U) for inv(A).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgetri( n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n,ipiv(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine cgetri
#else
module procedure stdlib${ii}$_cgetri
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgetri( n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n,ipiv(*)
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: work(*)
end subroutine dgetri
#else
module procedure stdlib${ii}$_dgetri
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgetri( n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n,ipiv(*)
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: work(*)
end subroutine sgetri
#else
module procedure stdlib${ii}$_sgetri
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgetri( n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n,ipiv(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zgetri
#else
module procedure stdlib${ii}$_zgetri
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getri
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getri
#:endif
#:endfor
#:endfor
end interface getri
interface getrs
!! GETRS solves a system of linear equations
!! A * X = B, A**T * X = B, or A**H * X = B
!! with a general N-by-N matrix A using the LU factorization computed
!! by CGETRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine cgetrs
#else
module procedure stdlib${ii}$_cgetrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
real(dp), intent(in) :: a(lda,*)
real(dp), intent(inout) :: b(ldb,*)
end subroutine dgetrs
#else
module procedure stdlib${ii}$_dgetrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
real(sp), intent(in) :: a(lda,*)
real(sp), intent(inout) :: b(ldb,*)
end subroutine sgetrs
#else
module procedure stdlib${ii}$_sgetrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zgetrs
#else
module procedure stdlib${ii}$_zgetrs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getrs
#:endif
#:endfor
#:endfor
end interface getrs
interface getsls
!! GETSLS solves overdetermined or underdetermined complex linear systems
!! involving an M-by-N matrix A, using a tall skinny QR or short wide LQ
!! factorization of A. It is assumed that A has full rank.
!! The following options are provided:
!! 1. If TRANS = 'N' and m >= n: find the least squares solution of
!! an overdetermined system, i.e., solve the least squares problem
!! minimize || B - A*X ||.
!! 2. If TRANS = 'N' and m < n: find the minimum norm solution of
!! an underdetermined system A * X = B.
!! 3. If TRANS = 'C' and m >= n: find the minimum norm solution of
!! an undetermined system A**T * X = B.
!! 4. If TRANS = 'C' and m < n: find the least squares solution of
!! an overdetermined system, i.e., solve the least squares problem
!! minimize || B - A**T * X ||.
!! Several right hand side vectors b and solution vectors x can be
!! handled in a single call; they are stored as the columns of the
!! M-by-NRHS right hand side matrix B and the N-by-NRHS solution
!! matrix X.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine cgetsls
#else
module procedure stdlib${ii}$_cgetsls
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: work(*)
end subroutine dgetsls
#else
module procedure stdlib${ii}$_dgetsls
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: work(*)
end subroutine sgetsls
#else
module procedure stdlib${ii}$_sgetsls
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zgetsls
#else
module procedure stdlib${ii}$_zgetsls
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getsls
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getsls
#:endif
#:endfor
#:endfor
end interface getsls
interface getsqrhrt
!! GETSQRHRT computes a NB2-sized column blocked QR-factorization
!! of a complex M-by-N matrix A with M >= N,
!! A = Q * R.
!! The routine uses internally a NB1-sized column blocked and MB1-sized
!! row blocked TSQR-factorization and perfors the reconstruction
!! of the Householder vectors from the TSQR output. The routine also
!! converts the R_tsqr factor from the TSQR-factorization output into
!! the R factor that corresponds to the Householder QR-factorization,
!! A = Q_tsqr * R_tsqr = Q * R.
!! The output Q and R factors are stored in the same format as in CGEQRT
!! (Q is in blocked compact WY-representation). See the documentation
!! of CGEQRT for more details on the format.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,lwork,m,n,nb1,nb2,mb1
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: t(ldt,*),work(*)
end subroutine cgetsqrhrt
#else
module procedure stdlib${ii}$_cgetsqrhrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,lwork,m,n,nb1,nb2,mb1
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: t(ldt,*),work(*)
end subroutine dgetsqrhrt
#else
module procedure stdlib${ii}$_dgetsqrhrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,lwork,m,n,nb1,nb2,mb1
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: t(ldt,*),work(*)
end subroutine sgetsqrhrt
#else
module procedure stdlib${ii}$_sgetsqrhrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldt,lwork,m,n,nb1,nb2,mb1
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: t(ldt,*),work(*)
end subroutine zgetsqrhrt
#else
module procedure stdlib${ii}$_zgetsqrhrt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getsqrhrt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$getsqrhrt
#:endif
#:endfor
#:endfor
end interface getsqrhrt
interface ggbak
!! GGBAK forms the right or left eigenvectors of a complex generalized
!! eigenvalue problem A*x = lambda*B*x, by backward transformation on
!! the computed eigenvectors of the balanced pair of matrices output by
!! CGGBAL.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: lscale(*),rscale(*)
complex(sp), intent(inout) :: v(ldv,*)
end subroutine cggbak
#else
module procedure stdlib${ii}$_cggbak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: lscale(*),rscale(*)
real(dp), intent(inout) :: v(ldv,*)
end subroutine dggbak
#else
module procedure stdlib${ii}$_dggbak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: lscale(*),rscale(*)
real(sp), intent(inout) :: v(ldv,*)
end subroutine sggbak
#else
module procedure stdlib${ii}$_sggbak
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job,side
integer(${ik}$), intent(in) :: ihi,ilo,ldv,m,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: lscale(*),rscale(*)
complex(dp), intent(inout) :: v(ldv,*)
end subroutine zggbak
#else
module procedure stdlib${ii}$_zggbak
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggbak
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggbak
#:endif
#:endfor
#:endfor
end interface ggbak
interface ggbal
!! GGBAL balances a pair of general complex matrices (A,B). This
!! involves, first, permuting A and B by similarity transformations to
!! isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
!! elements on the diagonal; and second, applying a diagonal similarity
!! transformation to rows and columns ILO to IHI to make the rows
!! and columns as close in norm as possible. Both steps are optional.
!! Balancing may reduce the 1-norm of the matrices, and improve the
!! accuracy of the computed eigenvalues and/or eigenvectors in the
!! generalized eigenvalue problem A*x = lambda*B*x.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,ldb,n
real(sp), intent(out) :: lscale(*),rscale(*),work(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine cggbal
#else
module procedure stdlib${ii}$_cggbal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,ldb,n
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: lscale(*),rscale(*),work(*)
end subroutine dggbal
#else
module procedure stdlib${ii}$_dggbal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,ldb,n
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: lscale(*),rscale(*),work(*)
end subroutine sggbal
#else
module procedure stdlib${ii}$_sggbal
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: job
integer(${ik}$), intent(out) :: ihi,ilo,info
integer(${ik}$), intent(in) :: lda,ldb,n
real(dp), intent(out) :: lscale(*),rscale(*),work(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine zggbal
#else
module procedure stdlib${ii}$_zggbal
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggbal
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggbal
#:endif
#:endfor
#:endfor
end interface ggbal
interface gges
!! GGES computes for a pair of N-by-N complex nonsymmetric matrices
!! (A,B), the generalized eigenvalues, the generalized complex Schur
!! form (S, T), and optionally left and/or right Schur vectors (VSL
!! and VSR). This gives the generalized Schur factorization
!! (A,B) = ( (VSL)*S*(VSR)**H, (VSL)*T*(VSR)**H )
!! where (VSR)**H is the conjugate-transpose of VSR.
!! Optionally, it also orders the eigenvalues so that a selected cluster
!! of eigenvalues appears in the leading diagonal blocks of the upper
!! triangular matrix S and the upper triangular matrix T. The leading
!! columns of VSL and VSR then form an unitary basis for the
!! corresponding left and right eigenspaces (deflating subspaces).
!! (If only the generalized eigenvalues are needed, use the driver
!! CGGEV instead, which is faster.)
!! A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
!! or a ratio alpha/beta = w, such that A - w*B is singular. It is
!! usually represented as the pair (alpha,beta), as there is a
!! reasonable interpretation for beta=0, and even for both being zero.
!! A pair of matrices (S,T) is in generalized complex Schur form if S
!! and T are upper triangular and, in addition, the diagonal elements
!! of T are non-negative real numbers.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, &
beta, vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_selctg_c
implicit none
character, intent(in) :: jobvsl,jobvsr,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldb,ldvsl,ldvsr,lwork,n
logical(lk), intent(out) :: bwork(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: alpha(*),beta(*),vsl(ldvsl,*),vsr(ldvsr,*),work(*)
procedure(stdlib_selctg_c) :: selctg
end subroutine cgges
#else
module procedure stdlib${ii}$_cgges
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, &
alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_selctg_d
implicit none
character, intent(in) :: jobvsl,jobvsr,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldb,ldvsl,ldvsr,lwork,n
logical(lk), intent(out) :: bwork(*)
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: alphai(*),alphar(*),beta(*),vsl(ldvsl,*),vsr(ldvsr,*)&
,work(*)
procedure(stdlib_selctg_d) :: selctg
end subroutine dgges
#else
module procedure stdlib${ii}$_dgges
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, &
alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_selctg_s
implicit none
character, intent(in) :: jobvsl,jobvsr,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldb,ldvsl,ldvsr,lwork,n
logical(lk), intent(out) :: bwork(*)
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: alphai(*),alphar(*),beta(*),vsl(ldvsl,*),vsr(ldvsr,*)&
,work(*)
procedure(stdlib_selctg_s) :: selctg
end subroutine sgges
#else
module procedure stdlib${ii}$_sgges
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, &
beta, vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info )
import sp,dp,qp,${ik}$,lk,stdlib_selctg_z
implicit none
character, intent(in) :: jobvsl,jobvsr,sort
integer(${ik}$), intent(out) :: info,sdim
integer(${ik}$), intent(in) :: lda,ldb,ldvsl,ldvsr,lwork,n
logical(lk), intent(out) :: bwork(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: alpha(*),beta(*),vsl(ldvsl,*),vsr(ldvsr,*),work(*)
procedure(stdlib_selctg_z) :: selctg
end subroutine zgges
#else
module procedure stdlib${ii}$_zgges
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gges
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gges
#:endif
#:endfor
#:endfor
end interface gges
interface ggev
!! GGEV computes for a pair of N-by-N complex nonsymmetric matrices
!! (A,B), the generalized eigenvalues, and optionally, the left and/or
!! right generalized eigenvectors.
!! A generalized eigenvalue for a pair of matrices (A,B) is a scalar
!! lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
!! singular. It is usually represented as the pair (alpha,beta), as
!! there is a reasonable interpretation for beta=0, and even for both
!! being zero.
!! The right generalized eigenvector v(j) corresponding to the
!! generalized eigenvalue lambda(j) of (A,B) satisfies
!! A * v(j) = lambda(j) * B * v(j).
!! The left generalized eigenvector u(j) corresponding to the
!! generalized eigenvalues lambda(j) of (A,B) satisfies
!! u(j)**H * A = lambda(j) * u(j)**H * B
!! where u(j)**H is the conjugate-transpose of u(j).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, &
work, lwork, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,ldvl,ldvr,lwork,n
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: alpha(*),beta(*),vl(ldvl,*),vr(ldvr,*),work(*)
end subroutine cggev
#else
module procedure stdlib${ii}$_cggev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, &
vr, ldvr, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,ldvl,ldvr,lwork,n
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: alphai(*),alphar(*),beta(*),vl(ldvl,*),vr(ldvr,*),&
work(*)
end subroutine dggev
#else
module procedure stdlib${ii}$_dggev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, &
vr, ldvr, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,ldvl,ldvr,lwork,n
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: alphai(*),alphar(*),beta(*),vl(ldvl,*),vr(ldvr,*),&
work(*)
end subroutine sggev
#else
module procedure stdlib${ii}$_sggev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, &
work, lwork, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobvl,jobvr
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,ldvl,ldvr,lwork,n
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: alpha(*),beta(*),vl(ldvl,*),vr(ldvr,*),work(*)
end subroutine zggev
#else
module procedure stdlib${ii}$_zggev
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggev
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggev
#:endif
#:endfor
#:endfor
end interface ggev
interface ggglm
!! GGGLM solves a general Gauss-Markov linear model (GLM) problem:
!! minimize || y ||_2 subject to d = A*x + B*y
!! x
!! where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
!! given N-vector. It is assumed that M <= N <= M+P, and
!! rank(A) = M and rank( A B ) = N.
!! Under these assumptions, the constrained equation is always
!! consistent, and there is a unique solution x and a minimal 2-norm
!! solution y, which is obtained using a generalized QR factorization
!! of the matrices (A, B) given by
!! A = Q*(R), B = Q*T*Z.
!! (0)
!! In particular, if matrix B is square nonsingular, then the problem
!! GLM is equivalent to the following weighted linear least squares
!! problem
!! minimize || inv(B)*(d-A*x) ||_2
!! x
!! where inv(B) denotes the inverse of B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(sp), intent(inout) :: a(lda,*),b(ldb,*),d(*)
complex(sp), intent(out) :: work(*),x(*),y(*)
end subroutine cggglm
#else
module procedure stdlib${ii}$_cggglm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(dp), intent(inout) :: a(lda,*),b(ldb,*),d(*)
real(dp), intent(out) :: work(*),x(*),y(*)
end subroutine dggglm
#else
module procedure stdlib${ii}$_dggglm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(sp), intent(inout) :: a(lda,*),b(ldb,*),d(*)
real(sp), intent(out) :: work(*),x(*),y(*)
end subroutine sggglm
#else
module procedure stdlib${ii}$_sggglm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(dp), intent(inout) :: a(lda,*),b(ldb,*),d(*)
complex(dp), intent(out) :: work(*),x(*),y(*)
end subroutine zggglm
#else
module procedure stdlib${ii}$_zggglm
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggglm
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggglm
#:endif
#:endfor
#:endfor
end interface ggglm
interface gghrd
!! GGHRD reduces a pair of complex matrices (A,B) to generalized upper
!! Hessenberg form using unitary transformations, where A is a
!! general matrix and B is upper triangular. The form of the generalized
!! eigenvalue problem is
!! A*x = lambda*B*x,
!! and B is typically made upper triangular by computing its QR
!! factorization and moving the unitary matrix Q to the left side
!! of the equation.
!! This subroutine simultaneously reduces A to a Hessenberg matrix H:
!! Q**H*A*Z = H
!! and transforms B to another upper triangular matrix T:
!! Q**H*B*Z = T
!! in order to reduce the problem to its standard form
!! H*y = lambda*T*y
!! where y = Z**H*x.
!! The unitary matrices Q and Z are determined as products of Givens
!! rotations. They may either be formed explicitly, or they may be
!! postmultiplied into input matrices Q1 and Z1, so that
!! Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
!! Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
!! If Q1 is the unitary matrix from the QR factorization of B in the
!! original equation A*x = lambda*B*x, then GGHRD reduces the original
!! problem to generalized Hessenberg form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz
integer(${ik}$), intent(in) :: ihi,ilo,lda,ldb,ldq,ldz,n
integer(${ik}$), intent(out) :: info
complex(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine cgghrd
#else
module procedure stdlib${ii}$_cgghrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz
integer(${ik}$), intent(in) :: ihi,ilo,lda,ldb,ldq,ldz,n
integer(${ik}$), intent(out) :: info
real(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine dgghrd
#else
module procedure stdlib${ii}$_dgghrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz
integer(${ik}$), intent(in) :: ihi,ilo,lda,ldb,ldq,ldz,n
integer(${ik}$), intent(out) :: info
real(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine sgghrd
#else
module procedure stdlib${ii}$_sgghrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz
integer(${ik}$), intent(in) :: ihi,ilo,lda,ldb,ldq,ldz,n
integer(${ik}$), intent(out) :: info
complex(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine zgghrd
#else
module procedure stdlib${ii}$_zgghrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gghrd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gghrd
#:endif
#:endfor
#:endfor
end interface gghrd
interface gglse
!! GGLSE solves the linear equality-constrained least squares (LSE)
!! problem:
!! minimize || c - A*x ||_2 subject to B*x = d
!! where A is an M-by-N matrix, B is a P-by-N matrix, c is a given
!! M-vector, and d is a given P-vector. It is assumed that
!! P <= N <= M+P, and
!! rank(B) = P and rank( (A) ) = N.
!! ( (B) )
!! These conditions ensure that the LSE problem has a unique solution,
!! which is obtained using a generalized RQ factorization of the
!! matrices (B, A) given by
!! B = (0 R)*Q, A = Z*T*Q.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(sp), intent(inout) :: a(lda,*),b(ldb,*),c(*),d(*)
complex(sp), intent(out) :: work(*),x(*)
end subroutine cgglse
#else
module procedure stdlib${ii}$_cgglse
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(dp), intent(inout) :: a(lda,*),b(ldb,*),c(*),d(*)
real(dp), intent(out) :: work(*),x(*)
end subroutine dgglse
#else
module procedure stdlib${ii}$_dgglse
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(sp), intent(inout) :: a(lda,*),b(ldb,*),c(*),d(*)
real(sp), intent(out) :: work(*),x(*)
end subroutine sgglse
#else
module procedure stdlib${ii}$_sgglse
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(dp), intent(inout) :: a(lda,*),b(ldb,*),c(*),d(*)
complex(dp), intent(out) :: work(*),x(*)
end subroutine zgglse
#else
module procedure stdlib${ii}$_zgglse
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gglse
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gglse
#:endif
#:endfor
#:endfor
end interface gglse
interface ggqrf
!! GGQRF computes a generalized QR factorization of an N-by-M matrix A
!! and an N-by-P matrix B:
!! A = Q*R, B = Q*T*Z,
!! where Q is an N-by-N unitary matrix, Z is a P-by-P unitary matrix,
!! and R and T assume one of the forms:
!! if N >= M, R = ( R11 ) M , or if N < M, R = ( R11 R12 ) N,
!! ( 0 ) N-M N M-N
!! M
!! where R11 is upper triangular, and
!! if N <= P, T = ( 0 T12 ) N, or if N > P, T = ( T11 ) N-P,
!! P-N N ( T21 ) P
!! P
!! where T12 or T21 is upper triangular.
!! In particular, if B is square and nonsingular, the GQR factorization
!! of A and B implicitly gives the QR factorization of inv(B)*A:
!! inv(B)*A = Z**H * (inv(T)*R)
!! where inv(B) denotes the inverse of the matrix B, and Z' denotes the
!! conjugate transpose of matrix Z.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: taua(*),taub(*),work(*)
end subroutine cggqrf
#else
module procedure stdlib${ii}$_cggqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: taua(*),taub(*),work(*)
end subroutine dggqrf
#else
module procedure stdlib${ii}$_dggqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: taua(*),taub(*),work(*)
end subroutine sggqrf
#else
module procedure stdlib${ii}$_sggqrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: taua(*),taub(*),work(*)
end subroutine zggqrf
#else
module procedure stdlib${ii}$_zggqrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggqrf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggqrf
#:endif
#:endfor
#:endfor
end interface ggqrf
interface ggrqf
!! GGRQF computes a generalized RQ factorization of an M-by-N matrix A
!! and a P-by-N matrix B:
!! A = R*Q, B = Z*T*Q,
!! where Q is an N-by-N unitary matrix, Z is a P-by-P unitary
!! matrix, and R and T assume one of the forms:
!! if M <= N, R = ( 0 R12 ) M, or if M > N, R = ( R11 ) M-N,
!! N-M M ( R21 ) N
!! N
!! where R12 or R21 is upper triangular, and
!! if P >= N, T = ( T11 ) N , or if P < N, T = ( T11 T12 ) P,
!! ( 0 ) P-N P N-P
!! N
!! where T11 is upper triangular.
!! In particular, if B is square and nonsingular, the GRQ factorization
!! of A and B implicitly gives the RQ factorization of A*inv(B):
!! A*inv(B) = (R*inv(T))*Z**H
!! where inv(B) denotes the inverse of the matrix B, and Z**H denotes the
!! conjugate transpose of the matrix Z.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: taua(*),taub(*),work(*)
end subroutine cggrqf
#else
module procedure stdlib${ii}$_cggrqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(out) :: taua(*),taub(*),work(*)
end subroutine dggrqf
#else
module procedure stdlib${ii}$_dggrqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(out) :: taua(*),taub(*),work(*)
end subroutine sggrqf
#else
module procedure stdlib${ii}$_sggrqf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,lwork,m,n,p
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: taua(*),taub(*),work(*)
end subroutine zggrqf
#else
module procedure stdlib${ii}$_zggrqf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggrqf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$ggrqf
#:endif
#:endfor
#:endfor
end interface ggrqf
interface gsvj0
!! GSVJ0 is called from CGESVJ as a pre-processor and that is its main
!! purpose. It applies Jacobi rotations in the same way as CGESVJ does, but
!! it does not check convergence (stopping criterion). Few tuning
!! parameters (marked by [TP]) are available for the implementer.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, &
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,nsweep
real(sp), intent(in) :: eps,sfmin,tol
character, intent(in) :: jobv
complex(sp), intent(inout) :: a(lda,*),d(n),v(ldv,*)
complex(sp), intent(out) :: work(lwork)
real(sp), intent(inout) :: sva(n)
end subroutine cgsvj0
#else
module procedure stdlib${ii}$_cgsvj0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, &
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,nsweep
real(dp), intent(in) :: eps,sfmin,tol
character, intent(in) :: jobv
real(dp), intent(inout) :: a(lda,*),sva(n),d(n),v(ldv,*)
real(dp), intent(out) :: work(lwork)
end subroutine dgsvj0
#else
module procedure stdlib${ii}$_dgsvj0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, &
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,nsweep
real(sp), intent(in) :: eps,sfmin,tol
character, intent(in) :: jobv
real(sp), intent(inout) :: a(lda,*),sva(n),d(n),v(ldv,*)
real(sp), intent(out) :: work(lwork)
end subroutine sgsvj0
#else
module procedure stdlib${ii}$_sgsvj0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, &
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,nsweep
real(dp), intent(in) :: eps,sfmin,tol
character, intent(in) :: jobv
complex(dp), intent(inout) :: a(lda,*),d(n),v(ldv,*)
complex(dp), intent(out) :: work(lwork)
real(dp), intent(inout) :: sva(n)
end subroutine zgsvj0
#else
module procedure stdlib${ii}$_zgsvj0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gsvj0
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gsvj0
#:endif
#:endfor
#:endfor
end interface gsvj0
interface gsvj1
!! GSVJ1 is called from CGESVJ as a pre-processor and that is its main
!! purpose. It applies Jacobi rotations in the same way as CGESVJ does, but
!! it targets only particular pivots and it does not check convergence
!! (stopping criterion). Few tuning parameters (marked by [TP]) are
!! available for the implementer.
!! Further Details
!! ~~~~~~~~~~~~~~~
!! GSVJ1 applies few sweeps of Jacobi rotations in the column space of
!! the input M-by-N matrix A. The pivot pairs are taken from the (1,2)
!! off-diagonal block in the corresponding N-by-N Gram matrix A^T * A. The
!! block-entries (tiles) of the (1,2) off-diagonal block are marked by the
!! [x]'s in the following scheme:
!! | * * * [x] [x] [x]|
!! | * * * [x] [x] [x]| Row-cycling in the nblr-by-nblc [x] blocks.
!! | * * * [x] [x] [x]| Row-cyclic pivoting inside each [x] block.
!! |[x] [x] [x] * * * |
!! |[x] [x] [x] * * * |
!! |[x] [x] [x] * * * |
!! In terms of the columns of A, the first N1 columns are rotated 'against'
!! the remaining N-N1 columns, trying to increase the angle between the
!! corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is
!! tiled using quadratic tiles of side KBL. Here, KBL is a tuning parameter.
!! The number of sweeps is given in NSWEEP and the orthogonality threshold
!! is given in TOL.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,&
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: eps,sfmin,tol
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,n1,nsweep
character, intent(in) :: jobv
complex(sp), intent(inout) :: a(lda,*),d(n),v(ldv,*)
complex(sp), intent(out) :: work(lwork)
real(sp), intent(inout) :: sva(n)
end subroutine cgsvj1
#else
module procedure stdlib${ii}$_cgsvj1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,&
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: eps,sfmin,tol
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,n1,nsweep
character, intent(in) :: jobv
real(dp), intent(inout) :: a(lda,*),d(n),sva(n),v(ldv,*)
real(dp), intent(out) :: work(lwork)
end subroutine dgsvj1
#else
module procedure stdlib${ii}$_dgsvj1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,&
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: eps,sfmin,tol
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,n1,nsweep
character, intent(in) :: jobv
real(sp), intent(inout) :: a(lda,*),d(n),sva(n),v(ldv,*)
real(sp), intent(out) :: work(lwork)
end subroutine sgsvj1
#else
module procedure stdlib${ii}$_sgsvj1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,&
nsweep, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: eps,sfmin,tol
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldv,lwork,m,mv,n,n1,nsweep
character, intent(in) :: jobv
complex(dp), intent(inout) :: a(lda,*),d(n),v(ldv,*)
complex(dp), intent(out) :: work(lwork)
real(dp), intent(inout) :: sva(n)
end subroutine zgsvj1
#else
module procedure stdlib${ii}$_zgsvj1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gsvj1
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gsvj1
#:endif
#:endfor
#:endfor
end interface gsvj1
interface gtcon
!! GTCON estimates the reciprocal of the condition number of a complex
!! tridiagonal matrix A using the LU factorization as computed by
!! CGTTRF.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond
complex(sp), intent(in) :: d(*),dl(*),du(*),du2(*)
complex(sp), intent(out) :: work(*)
end subroutine cgtcon
#else
module procedure stdlib${ii}$_cgtcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: n,ipiv(*)
real(dp), intent(in) :: anorm,d(*),dl(*),du(*),du2(*)
real(dp), intent(out) :: rcond,work(*)
end subroutine dgtcon
#else
module procedure stdlib${ii}$_dgtcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: n,ipiv(*)
real(sp), intent(in) :: anorm,d(*),dl(*),du(*),du2(*)
real(sp), intent(out) :: rcond,work(*)
end subroutine sgtcon
#else
module procedure stdlib${ii}$_sgtcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond
complex(dp), intent(in) :: d(*),dl(*),du(*),du2(*)
complex(dp), intent(out) :: work(*)
end subroutine zgtcon
#else
module procedure stdlib${ii}$_zgtcon
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtcon
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtcon
#:endif
#:endfor
#:endfor
end interface gtcon
interface gtrfs
!! GTRFS improves the computed solution to a system of linear
!! equations when the coefficient matrix is tridiagonal, and provides
!! error bounds and backward error estimates for the solution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, &
x, ldx, ferr, berr, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(sp), intent(in) :: b(ldb,*),d(*),df(*),dl(*),dlf(*),du(*),du2(*),duf(&
*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine cgtrfs
#else
module procedure stdlib${ii}$_cgtrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, &
x, ldx, ferr, berr, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(in) :: b(ldb,*),d(*),df(*),dl(*),dlf(*),du(*),du2(*),duf(*)
real(dp), intent(out) :: berr(*),ferr(*),work(*)
real(dp), intent(inout) :: x(ldx,*)
end subroutine dgtrfs
#else
module procedure stdlib${ii}$_dgtrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, &
x, ldx, ferr, berr, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(in) :: b(ldb,*),d(*),df(*),dl(*),dlf(*),du(*),du2(*),duf(*)
real(sp), intent(out) :: berr(*),ferr(*),work(*)
real(sp), intent(inout) :: x(ldx,*)
end subroutine sgtrfs
#else
module procedure stdlib${ii}$_sgtrfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, &
x, ldx, ferr, berr, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(dp), intent(in) :: b(ldb,*),d(*),df(*),dl(*),dlf(*),du(*),du2(*),duf(&
*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zgtrfs
#else
module procedure stdlib${ii}$_zgtrfs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtrfs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtrfs
#:endif
#:endfor
#:endfor
end interface gtrfs
interface gtsv
!! GTSV solves the equation
!! A*X = B,
!! where A is an N-by-N tridiagonal matrix, by Gaussian elimination with
!! partial pivoting.
!! Note that the equation A**T *X = B may be solved by interchanging the
!! order of the arguments DU and DL.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgtsv( n, nrhs, dl, d, du, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs
complex(sp), intent(inout) :: b(ldb,*),d(*),dl(*),du(*)
end subroutine cgtsv
#else
module procedure stdlib${ii}$_cgtsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgtsv( n, nrhs, dl, d, du, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs
real(dp), intent(inout) :: b(ldb,*),d(*),dl(*),du(*)
end subroutine dgtsv
#else
module procedure stdlib${ii}$_dgtsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgtsv( n, nrhs, dl, d, du, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs
real(sp), intent(inout) :: b(ldb,*),d(*),dl(*),du(*)
end subroutine sgtsv
#else
module procedure stdlib${ii}$_sgtsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgtsv( n, nrhs, dl, d, du, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs
complex(dp), intent(inout) :: b(ldb,*),d(*),dl(*),du(*)
end subroutine zgtsv
#else
module procedure stdlib${ii}$_zgtsv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtsv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gtsv
#:endif
#:endfor
#:endfor
end interface gtsv
interface gttrf
!! GTTRF computes an LU factorization of a complex tridiagonal matrix A
!! using elimination with partial pivoting and row interchanges.
!! The factorization has the form
!! A = L * U
!! where L is a product of permutation and unit lower bidiagonal
!! matrices and U is upper triangular with nonzeros in only the main
!! diagonal and first two superdiagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgttrf( n, dl, d, du, du2, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
complex(sp), intent(inout) :: d(*),dl(*),du(*)
complex(sp), intent(out) :: du2(*)
end subroutine cgttrf
#else
module procedure stdlib${ii}$_cgttrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgttrf( n, dl, d, du, du2, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: d(*),dl(*),du(*)
real(dp), intent(out) :: du2(*)
end subroutine dgttrf
#else
module procedure stdlib${ii}$_dgttrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgttrf( n, dl, d, du, du2, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: d(*),dl(*),du(*)
real(sp), intent(out) :: du2(*)
end subroutine sgttrf
#else
module procedure stdlib${ii}$_sgttrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgttrf( n, dl, d, du, du2, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
complex(dp), intent(inout) :: d(*),dl(*),du(*)
complex(dp), intent(out) :: du2(*)
end subroutine zgttrf
#else
module procedure stdlib${ii}$_zgttrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gttrf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gttrf
#:endif
#:endfor
#:endfor
end interface gttrf
interface gttrs
!! GTTRS solves one of the systems of equations
!! A * X = B, A**T * X = B, or A**H * X = B,
!! with a tridiagonal matrix A using the LU factorization computed
!! by CGTTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(in) :: d(*),dl(*),du(*),du2(*)
end subroutine cgttrs
#else
module procedure stdlib${ii}$_cgttrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
real(dp), intent(inout) :: b(ldb,*)
real(dp), intent(in) :: d(*),dl(*),du(*),du2(*)
end subroutine dgttrs
#else
module procedure stdlib${ii}$_dgttrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
real(sp), intent(inout) :: b(ldb,*)
real(sp), intent(in) :: d(*),dl(*),du(*),du2(*)
end subroutine sgttrs
#else
module procedure stdlib${ii}$_sgttrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(in) :: d(*),dl(*),du(*),du2(*)
end subroutine zgttrs
#else
module procedure stdlib${ii}$_zgttrs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gttrs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$gttrs
#:endif
#:endfor
#:endfor
end interface gttrs
interface hb2st_kernels
!! HB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST
!! subroutine.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, &
lda, v, tau, ldvt, work)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: wantz
integer(${ik}$), intent(in) :: ttype,st,ed,sweep,n,nb,ib,lda,ldvt
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: v(*),tau(*),work(*)
end subroutine chb2st_kernels
#else
module procedure stdlib${ii}$_chb2st_kernels
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, &
lda, v, tau, ldvt, work)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: wantz
integer(${ik}$), intent(in) :: ttype,st,ed,sweep,n,nb,ib,lda,ldvt
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: v(*),tau(*),work(*)
end subroutine zhb2st_kernels
#else
module procedure stdlib${ii}$_zhb2st_kernels
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hb2st_kernels
#:endif
#:endfor
#:endfor
end interface hb2st_kernels
interface hbev
!! HBEV computes all the eigenvalues and, optionally, eigenvectors of
!! a complex Hermitian band matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,ldz,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ab(ldab,*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chbev
#else
module procedure stdlib${ii}$_chbev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,ldz,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ab(ldab,*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhbev
#else
module procedure stdlib${ii}$_zhbev
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbev
#:endif
#:endfor
#:endfor
end interface hbev
interface hbevd
!! HBEVD computes all the eigenvalues and, optionally, eigenvectors of
!! a complex Hermitian band matrix A. If eigenvectors are desired, it
!! uses a divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kd,ldab,ldz,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ab(ldab,*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chbevd
#else
module procedure stdlib${ii}$_chbevd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: kd,ldab,ldz,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ab(ldab,*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhbevd
#else
module procedure stdlib${ii}$_zhbevd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbevd
#:endif
#:endfor
#:endfor
end interface hbevd
interface hbgst
!! HBGST reduces a complex Hermitian-definite banded generalized
!! eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y,
!! such that C has the same bandwidth as A.
!! B must have been previously factorized as S**H*S by CPBSTF, using a
!! split Cholesky factorization. A is overwritten by C = X**H*A*X, where
!! X = S**(-1)*Q and Q is a unitary matrix chosen to preserve the
!! bandwidth of A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo,vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldx,n
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: ab(ldab,*)
complex(sp), intent(in) :: bb(ldbb,*)
complex(sp), intent(out) :: work(*),x(ldx,*)
end subroutine chbgst
#else
module procedure stdlib${ii}$_chbgst
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo,vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldx,n
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: ab(ldab,*)
complex(dp), intent(in) :: bb(ldbb,*)
complex(dp), intent(out) :: work(*),x(ldx,*)
end subroutine zhbgst
#else
module procedure stdlib${ii}$_zhbgst
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbgst
#:endif
#:endfor
#:endfor
end interface hbgst
interface hbgv
!! HBGV computes all the eigenvalues, and optionally, the eigenvectors
!! of a complex generalized Hermitian-definite banded eigenproblem, of
!! the form A*x=(lambda)*B*x. Here A and B are assumed to be Hermitian
!! and banded, and B is also positive definite.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldz,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ab(ldab,*),bb(ldbb,*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chbgv
#else
module procedure stdlib${ii}$_chbgv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, &
rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldz,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ab(ldab,*),bb(ldbb,*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhbgv
#else
module procedure stdlib${ii}$_zhbgv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbgv
#:endif
#:endfor
#:endfor
end interface hbgv
interface hbgvd
!! HBGVD computes all the eigenvalues, and optionally, the eigenvectors
!! of a complex generalized Hermitian-definite banded eigenproblem, of
!! the form A*x=(lambda)*B*x. Here A and B are assumed to be Hermitian
!! and banded, and B is also positive definite. If eigenvectors are
!! desired, it uses a divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, &
lwork, rwork, lrwork, iwork,liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldz,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ab(ldab,*),bb(ldbb,*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chbgvd
#else
module procedure stdlib${ii}$_chbgvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, &
lwork, rwork, lrwork, iwork,liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ka,kb,ldab,ldbb,ldz,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ab(ldab,*),bb(ldbb,*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhbgvd
#else
module procedure stdlib${ii}$_zhbgvd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbgvd
#:endif
#:endfor
#:endfor
end interface hbgvd
interface hbtrd
!! HBTRD reduces a complex Hermitian band matrix A to real symmetric
!! tridiagonal form T by a unitary similarity transformation:
!! Q**H * A * Q = T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo,vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,ldq,n
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: ab(ldab,*),q(ldq,*)
complex(sp), intent(out) :: work(*)
end subroutine chbtrd
#else
module procedure stdlib${ii}$_chbtrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo,vect
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,ldq,n
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: ab(ldab,*),q(ldq,*)
complex(dp), intent(out) :: work(*)
end subroutine zhbtrd
#else
module procedure stdlib${ii}$_zhbtrd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hbtrd
#:endif
#:endfor
#:endfor
end interface hbtrd
interface hecon
!! HECON estimates the reciprocal of the condition number of a complex
!! Hermitian matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHETRF.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine checon
#else
module procedure stdlib${ii}$_checon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhecon
#else
module procedure stdlib${ii}$_zhecon
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hecon
#:endif
#:endfor
#:endfor
end interface hecon
interface hecon_rook
!! HECON_ROOK estimates the reciprocal of the condition number of a complex
!! Hermitian matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHETRF_ROOK.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine checon_rook
#else
module procedure stdlib${ii}$_checon_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhecon_rook
#else
module procedure stdlib${ii}$_zhecon_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hecon_rook
#:endif
#:endfor
#:endfor
end interface hecon_rook
interface heequb
!! HEEQUB computes row and column scalings intended to equilibrate a
!! Hermitian matrix A (with respect to the Euclidean norm) and reduce
!! its condition number. The scale factors S are computed by the BIN
!! algorithm (see references) so that the scaled matrix B with elements
!! B(i,j) = S(i)*A(i,j)*S(j) has a condition number within a factor N of
!! the smallest possible condition number over all possible diagonal
!! scalings.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cheequb( uplo, n, a, lda, s, scond, amax, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(out) :: amax,scond,s(*)
character, intent(in) :: uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine cheequb
#else
module procedure stdlib${ii}$_cheequb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zheequb( uplo, n, a, lda, s, scond, amax, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(out) :: amax,scond,s(*)
character, intent(in) :: uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zheequb
#else
module procedure stdlib${ii}$_zheequb
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$heequb
#:endif
#:endfor
#:endfor
end interface heequb
interface heev
!! HEEV computes all eigenvalues and, optionally, eigenvectors of a
!! complex Hermitian matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine cheev
#else
module procedure stdlib${ii}$_cheev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zheev
#else
module procedure stdlib${ii}$_zheev
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$heev
#:endif
#:endfor
#:endfor
end interface heev
interface heevd
!! HEEVD computes all eigenvalues and, optionally, eigenvectors of a
!! complex Hermitian matrix A. If eigenvectors are desired, it uses a
!! divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, &
liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine cheevd
#else
module procedure stdlib${ii}$_cheevd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, &
liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: lda,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zheevd
#else
module procedure stdlib${ii}$_zheevd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$heevd
#:endif
#:endfor
#:endfor
end interface heevd
interface heevr
!! HEEVR computes selected eigenvalues and, optionally, eigenvectors
!! of a complex Hermitian matrix A. Eigenvalues and eigenvectors can
!! be selected by specifying either a range of values or a range of
!! indices for the desired eigenvalues.
!! HEEVR first reduces the matrix A to tridiagonal form T with a call
!! to CHETRD. Then, whenever possible, HEEVR calls CSTEMR to compute
!! the eigenspectrum using Relatively Robust Representations. CSTEMR
!! computes eigenvalues by the dqds algorithm, while orthogonal
!! eigenvectors are computed from various "good" L D L^T representations
!! (also known as Relatively Robust Representations). Gram-Schmidt
!! orthogonalization is avoided as far as possible. More specifically,
!! the various steps of the algorithm are as follows.
!! For each unreduced block (submatrix) of T,
!! (a) Compute T - sigma I = L D L^T, so that L and D
!! define all the wanted eigenvalues to high relative accuracy.
!! This means that small relative changes in the entries of D and L
!! cause only small relative changes in the eigenvalues and
!! eigenvectors. The standard (unfactored) representation of the
!! tridiagonal matrix T does not have this property in general.
!! (b) Compute the eigenvalues to suitable accuracy.
!! If the eigenvectors are desired, the algorithm attains full
!! accuracy of the computed eigenvalues only right before
!! the corresponding vectors have to be computed, see steps c) and d).
!! (c) For each cluster of close eigenvalues, select a new
!! shift close to the cluster, find a new factorization, and refine
!! the shifted eigenvalues to suitable accuracy.
!! (d) For each eigenvalue with a large enough relative separation compute
!! the corresponding eigenvector by forming a rank revealing twisted
!! factorization. Go back to (c) for any clusters that remain.
!! The desired accuracy of the output can be specified by the input
!! parameter ABSTOL.
!! For more details, see CSTEMR's documentation and:
!! - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
!! to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
!! Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
!! - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
!! Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
!! 2004. Also LAPACK Working Note 154.
!! - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
!! tridiagonal eigenvalue/eigenvector problem",
!! Computer Science Division Technical Report No. UCB/CSD-97-971,
!! UC Berkeley, May 1997.
!! Note 1 : HEEVR calls CSTEMR when the full spectrum is requested
!! on machines which conform to the ieee-754 floating point standard.
!! HEEVR calls SSTEBZ and CSTEIN on non-ieee machines and
!! when partial spectrum requests are made.
!! Normal execution of CSTEMR may create NaNs and infinities and
!! hence may abort due to a floating point exception in environments
!! which do not handle NaNs and infinities in the ieee standard default
!! manner.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, &
ldz, isuppz, work, lwork,rwork, lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,range,uplo
integer(${ik}$), intent(in) :: il,iu,lda,ldz,liwork,lrwork,lwork,n
integer(${ik}$), intent(out) :: info,m,isuppz(*),iwork(*)
real(sp), intent(in) :: abstol,vl,vu
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine cheevr
#else
module procedure stdlib${ii}$_cheevr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, &
ldz, isuppz, work, lwork,rwork, lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,range,uplo
integer(${ik}$), intent(in) :: il,iu,lda,ldz,liwork,lrwork,lwork,n
integer(${ik}$), intent(out) :: info,m,isuppz(*),iwork(*)
real(dp), intent(in) :: abstol,vl,vu
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zheevr
#else
module procedure stdlib${ii}$_zheevr
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$heevr
#:endif
#:endfor
#:endfor
end interface heevr
interface hegst
!! HEGST reduces a complex Hermitian-definite generalized
!! eigenproblem to standard form.
!! If ITYPE = 1, the problem is A*x = lambda*B*x,
!! and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H)
!! If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
!! B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H*A*L.
!! B must have been previously factorized as U**H*U or L*L**H by CPOTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chegst( itype, uplo, n, a, lda, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,lda,ldb,n
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine chegst
#else
module procedure stdlib${ii}$_chegst
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhegst( itype, uplo, n, a, lda, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,lda,ldb,n
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
end subroutine zhegst
#else
module procedure stdlib${ii}$_zhegst
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hegst
#:endif
#:endfor
#:endfor
end interface hegst
interface hegv
!! HEGV computes all the eigenvalues, and optionally, the eigenvectors
!! of a complex generalized Hermitian-definite eigenproblem, of the form
!! A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
!! Here A and B are assumed to be Hermitian and B is also
!! positive definite.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,lda,ldb,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chegv
#else
module procedure stdlib${ii}$_chegv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,lda,ldb,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhegv
#else
module procedure stdlib${ii}$_zhegv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hegv
#:endif
#:endfor
#:endfor
end interface hegv
interface hegvd
!! HEGVD computes all the eigenvalues, and optionally, the eigenvectors
!! of a complex generalized Hermitian-definite eigenproblem, of the form
!! A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
!! B are assumed to be Hermitian and B is also positive definite.
!! If eigenvectors are desired, it uses a divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: itype,lda,ldb,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chegvd
#else
module procedure stdlib${ii}$_chegvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: itype,lda,ldb,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhegvd
#else
module procedure stdlib${ii}$_zhegvd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hegvd
#:endif
#:endfor
#:endfor
end interface hegvd
interface herfs
!! HERFS improves the computed solution to a system of linear
!! equations when the coefficient matrix is Hermitian indefinite, and
!! provides error bounds and backward error estimates for the solution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,&
berr, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(sp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine cherfs
#else
module procedure stdlib${ii}$_cherfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,&
berr, work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldaf,ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(dp), intent(in) :: a(lda,*),af(ldaf,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zherfs
#else
module procedure stdlib${ii}$_zherfs
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$herfs
#:endif
#:endfor
#:endfor
end interface herfs
interface hesv
!! HESV computes the solution to a complex system of linear equations
!! A * X = B,
!! where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
!! matrices.
!! The diagonal pivoting method is used to factor A as
!! A = U * D * U**H, if UPLO = 'U', or
!! A = L * D * L**H, if UPLO = 'L',
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and D is Hermitian and block diagonal with
!! 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
!! used to solve the system of equations A * X = B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chesv
#else
module procedure stdlib${ii}$_chesv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhesv
#else
module procedure stdlib${ii}$_zhesv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hesv
#:endif
#:endfor
#:endfor
end interface hesv
interface hesv_aa
!! HESV_AA computes the solution to a complex system of linear equations
!! A * X = B,
!! where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
!! matrices.
!! Aasen's algorithm is used to factor A as
!! A = U**H * T * U, if UPLO = 'U', or
!! A = L * T * L**H, if UPLO = 'L',
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and T is Hermitian and tridiagonal. The factored form
!! of A is then used to solve the system of equations A * X = B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chesv_aa
#else
module procedure stdlib${ii}$_chesv_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhesv_aa
#else
module procedure stdlib${ii}$_zhesv_aa
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hesv_aa
#:endif
#:endfor
#:endfor
end interface hesv_aa
interface hesv_rk
!! HESV_RK computes the solution to a complex system of linear
!! equations A * X = B, where A is an N-by-N Hermitian matrix
!! and X and B are N-by-NRHS matrices.
!! The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
!! to factor A as
!! A = P*U*D*(U**H)*(P**T), if UPLO = 'U', or
!! A = P*L*D*(L**H)*(P**T), if UPLO = 'L',
!! where U (or L) is unit upper (or lower) triangular matrix,
!! U**H (or L**H) is the conjugate of U (or L), P is a permutation
!! matrix, P**T is the transpose of P, and D is Hermitian and block
!! diagonal with 1-by-1 and 2-by-2 diagonal blocks.
!! CHETRF_RK is called to compute the factorization of a complex
!! Hermitian matrix. The factored form of A is then used to solve
!! the system of equations A * X = B by calling BLAS3 routine CHETRS_3.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: e(*),work(*)
end subroutine chesv_rk
#else
module procedure stdlib${ii}$_chesv_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: e(*),work(*)
end subroutine zhesv_rk
#else
module procedure stdlib${ii}$_zhesv_rk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hesv_rk
#:endif
#:endfor
#:endfor
end interface hesv_rk
interface hesv_rook
!! HESV_ROOK computes the solution to a complex system of linear equations
!! A * X = B,
!! where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
!! matrices.
!! The bounded Bunch-Kaufman ("rook") diagonal pivoting method is used
!! to factor A as
!! A = U * D * U**T, if UPLO = 'U', or
!! A = L * D * L**T, if UPLO = 'L',
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and D is Hermitian and block diagonal with
!! 1-by-1 and 2-by-2 diagonal blocks.
!! CHETRF_ROOK is called to compute the factorization of a complex
!! Hermition matrix A using the bounded Bunch-Kaufman ("rook") diagonal
!! pivoting method.
!! The factored form of A is then used to solve the system
!! of equations A * X = B by calling CHETRS_ROOK (uses BLAS 2).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chesv_rook
#else
module procedure stdlib${ii}$_chesv_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldb,lwork,n,nrhs
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhesv_rook
#else
module procedure stdlib${ii}$_zhesv_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hesv_rook
#:endif
#:endfor
#:endfor
end interface hesv_rook
interface heswapr
!! HESWAPR applies an elementary permutation on the rows and the columns of
!! a hermitian matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cheswapr( uplo, n, a, lda, i1, i2)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: i1,i2,lda,n
complex(sp), intent(inout) :: a(lda,n)
end subroutine cheswapr
#else
module procedure stdlib${ii}$_cheswapr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zheswapr( uplo, n, a, lda, i1, i2)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: i1,i2,lda,n
complex(dp), intent(inout) :: a(lda,n)
end subroutine zheswapr
#else
module procedure stdlib${ii}$_zheswapr
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$heswapr
#:endif
#:endfor
#:endfor
end interface heswapr
interface hetf2_rk
!! HETF2_RK computes the factorization of a complex Hermitian matrix A
!! using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
!! A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
!! where U (or L) is unit upper (or lower) triangular matrix,
!! U**H (or L**H) is the conjugate of U (or L), P is a permutation
!! matrix, P**T is the transpose of P, and D is Hermitian and block
!! diagonal with 1-by-1 and 2-by-2 diagonal blocks.
!! This is the unblocked version of the algorithm, calling Level 2 BLAS.
!! For more information see Further Details section.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetf2_rk( uplo, n, a, lda, e, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: e(*)
end subroutine chetf2_rk
#else
module procedure stdlib${ii}$_chetf2_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetf2_rk( uplo, n, a, lda, e, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: e(*)
end subroutine zhetf2_rk
#else
module procedure stdlib${ii}$_zhetf2_rk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetf2_rk
#:endif
#:endfor
#:endfor
end interface hetf2_rk
interface hetf2_rook
!! HETF2_ROOK computes the factorization of a complex Hermitian matrix A
!! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method:
!! A = U*D*U**H or A = L*D*L**H
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, U**H is the conjugate transpose of U, and D is
!! Hermitian and block diagonal with 1-by-1 and 2-by-2 diagonal blocks.
!! This is the unblocked version of the algorithm, calling Level 2 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetf2_rook( uplo, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,n
complex(sp), intent(inout) :: a(lda,*)
end subroutine chetf2_rook
#else
module procedure stdlib${ii}$_chetf2_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetf2_rook( uplo, n, a, lda, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,n
complex(dp), intent(inout) :: a(lda,*)
end subroutine zhetf2_rook
#else
module procedure stdlib${ii}$_zhetf2_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetf2_rook
#:endif
#:endfor
#:endfor
end interface hetf2_rook
interface hetrd
!! HETRD reduces a complex Hermitian matrix A to real symmetric
!! tridiagonal form T by a unitary similarity transformation:
!! Q**H * A * Q = T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrd( uplo, n, a, lda, d, e, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: tau(*),work(*)
end subroutine chetrd
#else
module procedure stdlib${ii}$_chetrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrd( uplo, n, a, lda, d, e, tau, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,lwork,n
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: tau(*),work(*)
end subroutine zhetrd
#else
module procedure stdlib${ii}$_zhetrd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrd
#:endif
#:endfor
#:endfor
end interface hetrd
interface hetrd_hb2st
!! HETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric
!! tridiagonal form T by a unitary similarity transformation:
!! Q**H * A * Q = T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, &
lhous, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: stage1,uplo,vect
integer(${ik}$), intent(in) :: n,kd,ldab,lhous,lwork
integer(${ik}$), intent(out) :: info
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: ab(ldab,*)
complex(sp), intent(out) :: hous(*),work(*)
end subroutine chetrd_hb2st
#else
module procedure stdlib${ii}$_chetrd_hb2st
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, &
lhous, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: stage1,uplo,vect
integer(${ik}$), intent(in) :: n,kd,ldab,lhous,lwork
integer(${ik}$), intent(out) :: info
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: ab(ldab,*)
complex(dp), intent(out) :: hous(*),work(*)
end subroutine zhetrd_hb2st
#else
module procedure stdlib${ii}$_zhetrd_hb2st
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrd_hb2st
#:endif
#:endfor
#:endfor
end interface hetrd_hb2st
interface hetrd_he2hb
!! HETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian
!! band-diagonal form AB by a unitary similarity transformation:
!! Q**H * A * Q = AB.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldab,lwork,n,kd
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: ab(ldab,*),tau(*),work(*)
end subroutine chetrd_he2hb
#else
module procedure stdlib${ii}$_chetrd_he2hb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldab,lwork,n,kd
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: ab(ldab,*),tau(*),work(*)
end subroutine zhetrd_he2hb
#else
module procedure stdlib${ii}$_zhetrd_he2hb
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrd_he2hb
#:endif
#:endfor
#:endfor
end interface hetrd_he2hb
interface hetrf
!! HETRF computes the factorization of a complex Hermitian matrix A
!! using the Bunch-Kaufman diagonal pivoting method. The form of the
!! factorization is
!! A = U*D*U**H or A = L*D*L**H
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and D is Hermitian and block diagonal with
!! 1-by-1 and 2-by-2 diagonal blocks.
!! This is the blocked version of the algorithm, calling Level 3 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrf( uplo, n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine chetrf
#else
module procedure stdlib${ii}$_chetrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrf( uplo, n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetrf
#else
module procedure stdlib${ii}$_zhetrf
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrf
#:endif
#:endfor
#:endfor
end interface hetrf
interface hetrf_aa
!! HETRF_AA computes the factorization of a complex hermitian matrix A
!! using the Aasen's algorithm. The form of the factorization is
!! A = U**H*T*U or A = L*T*L**H
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and T is a hermitian tridiagonal matrix.
!! This is the blocked version of the algorithm, calling Level 3 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,lwork
integer(${ik}$), intent(out) :: info,ipiv(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine chetrf_aa
#else
module procedure stdlib${ii}$_chetrf_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info)
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,lwork
integer(${ik}$), intent(out) :: info,ipiv(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetrf_aa
#else
module procedure stdlib${ii}$_zhetrf_aa
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrf_aa
#:endif
#:endfor
#:endfor
end interface hetrf_aa
interface hetrf_rk
!! HETRF_RK computes the factorization of a complex Hermitian matrix A
!! using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
!! A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
!! where U (or L) is unit upper (or lower) triangular matrix,
!! U**H (or L**H) is the conjugate of U (or L), P is a permutation
!! matrix, P**T is the transpose of P, and D is Hermitian and block
!! diagonal with 1-by-1 and 2-by-2 diagonal blocks.
!! This is the blocked version of the algorithm, calling Level 3 BLAS.
!! For more information see Further Details section.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: e(*),work(*)
end subroutine chetrf_rk
#else
module procedure stdlib${ii}$_chetrf_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: e(*),work(*)
end subroutine zhetrf_rk
#else
module procedure stdlib${ii}$_zhetrf_rk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrf_rk
#:endif
#:endfor
#:endfor
end interface hetrf_rk
interface hetrf_rook
!! HETRF_ROOK computes the factorization of a complex Hermitian matrix A
!! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
!! The form of the factorization is
!! A = U*D*U**T or A = L*D*L**T
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and D is Hermitian and block diagonal with
!! 1-by-1 and 2-by-2 diagonal blocks.
!! This is the blocked version of the algorithm, calling Level 3 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine chetrf_rook
#else
module procedure stdlib${ii}$_chetrf_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: lda,lwork,n
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetrf_rook
#else
module procedure stdlib${ii}$_zhetrf_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrf_rook
#:endif
#:endfor
#:endfor
end interface hetrf_rook
interface hetri
!! HETRI computes the inverse of a complex Hermitian indefinite matrix
!! A using the factorization A = U*D*U**H or A = L*D*L**H computed by
!! CHETRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetri( uplo, n, a, lda, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine chetri
#else
module procedure stdlib${ii}$_chetri
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetri( uplo, n, a, lda, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetri
#else
module procedure stdlib${ii}$_zhetri
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetri
#:endif
#:endfor
#:endfor
end interface hetri
interface hetri_rook
!! HETRI_ROOK computes the inverse of a complex Hermitian indefinite matrix
!! A using the factorization A = U*D*U**H or A = L*D*L**H computed by
!! CHETRF_ROOK.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetri_rook( uplo, n, a, lda, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*)
end subroutine chetri_rook
#else
module procedure stdlib${ii}$_chetri_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetri_rook( uplo, n, a, lda, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,n,ipiv(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetri_rook
#else
module procedure stdlib${ii}$_zhetri_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetri_rook
#:endif
#:endfor
#:endfor
end interface hetri_rook
interface hetrs
!! HETRS solves a system of linear equations A*X = B with a complex
!! Hermitian matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHETRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine chetrs
#else
module procedure stdlib${ii}$_chetrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zhetrs
#else
module procedure stdlib${ii}$_zhetrs
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrs
#:endif
#:endfor
#:endfor
end interface hetrs
interface hetrs2
!! HETRS2 solves a system of linear equations A*X = B with a complex
!! Hermitian matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHETRF and converted by CSYCONV.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chetrs2
#else
module procedure stdlib${ii}$_chetrs2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetrs2
#else
module procedure stdlib${ii}$_zhetrs2
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrs2
#:endif
#:endfor
#:endfor
end interface hetrs2
interface hetrs_3
!! HETRS_3 solves a system of linear equations A * X = B with a complex
!! Hermitian matrix A using the factorization computed
!! by CHETRF_RK or CHETRF_BK:
!! A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
!! where U (or L) is unit upper (or lower) triangular matrix,
!! U**H (or L**H) is the conjugate of U (or L), P is a permutation
!! matrix, P**T is the transpose of P, and D is Hermitian and block
!! diagonal with 1-by-1 and 2-by-2 diagonal blocks.
!! This algorithm is using Level 3 BLAS.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: a(lda,*),e(*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine chetrs_3
#else
module procedure stdlib${ii}$_chetrs_3
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: a(lda,*),e(*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zhetrs_3
#else
module procedure stdlib${ii}$_zhetrs_3
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrs_3
#:endif
#:endfor
#:endfor
end interface hetrs_3
interface hetrs_aa
!! HETRS_AA solves a system of linear equations A*X = B with a complex
!! hermitian matrix A using the factorization A = U**H*T*U or
!! A = L*T*L**H computed by CHETRF_AA.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,nrhs,lda,ldb,lwork,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine chetrs_aa
#else
module procedure stdlib${ii}$_chetrs_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,nrhs,lda,ldb,lwork,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zhetrs_aa
#else
module procedure stdlib${ii}$_zhetrs_aa
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrs_aa
#:endif
#:endfor
#:endfor
end interface hetrs_aa
interface hetrs_rook
!! HETRS_ROOK solves a system of linear equations A*X = B with a complex
!! Hermitian matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHETRF_ROOK.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine chetrs_rook
#else
module procedure stdlib${ii}$_chetrs_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zhetrs_rook
#else
module procedure stdlib${ii}$_zhetrs_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hetrs_rook
#:endif
#:endfor
#:endfor
end interface hetrs_rook
interface hfrk
!! Level 3 BLAS like routine for C in RFP Format.
!! HFRK 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_LAPACK${ii}$
pure subroutine chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: k,lda,n
character, intent(in) :: trans,transr,uplo
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(inout) :: c(*)
end subroutine chfrk
#else
module procedure stdlib${ii}$_chfrk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: k,lda,n
character, intent(in) :: trans,transr,uplo
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(inout) :: c(*)
end subroutine zhfrk
#else
module procedure stdlib${ii}$_zhfrk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hfrk
#:endif
#:endfor
#:endfor
end interface hfrk
interface hgeqz
!! HGEQZ computes the eigenvalues of a complex matrix pair (H,T),
!! where H is an upper Hessenberg matrix and T is upper triangular,
!! using the single-shift QZ method.
!! Matrix pairs of this type are produced by the reduction to
!! generalized upper Hessenberg form of a complex matrix pair (A,B):
!! A = Q1*H*Z1**H, B = Q1*T*Z1**H,
!! as computed by CGGHRD.
!! If JOB='S', then the Hessenberg-triangular pair (H,T) is
!! also reduced to generalized Schur form,
!! H = Q*S*Z**H, T = Q*P*Z**H,
!! where Q and Z are unitary matrices and S and P are upper triangular.
!! Optionally, the unitary matrix Q from the generalized Schur
!! factorization may be postmultiplied into an input matrix Q1, and the
!! unitary matrix Z may be postmultiplied into an input matrix Z1.
!! If Q1 and Z1 are the unitary matrices from CGGHRD that reduced
!! the matrix pair (A,B) to generalized Hessenberg form, then the output
!! matrices Q1*Q and Z1*Z are the unitary factors from the generalized
!! Schur factorization of (A,B):
!! A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
!! To avoid overflow, eigenvalues of the matrix pair (H,T)
!! (equivalently, of (A,B)) are computed as a pair of complex values
!! (alpha,beta). If beta is nonzero, lambda = alpha / beta is an
!! eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
!! A*x = lambda*B*x
!! and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
!! alternate form of the GNEP
!! mu*A*y = B*y.
!! The values of alpha and beta for the i-th eigenvalue can be read
!! directly from the generalized Schur form: alpha = S(i,i),
!! beta = P(i,i).
!! Ref: C.B. Moler
!! Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
!! pp. 241--256.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, &
ldq, z, ldz, work, lwork,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz,job
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldq,ldt,ldz,lwork,n
integer(${ik}$), intent(out) :: info
real(sp), intent(out) :: rwork(*)
complex(sp), intent(out) :: alpha(*),beta(*),work(*)
complex(sp), intent(inout) :: h(ldh,*),q(ldq,*),t(ldt,*),z(ldz,*)
end subroutine chgeqz
#else
module procedure stdlib${ii}$_chgeqz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, &
beta, q, ldq, z, ldz, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz,job
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldq,ldt,ldz,lwork,n
integer(${ik}$), intent(out) :: info
real(dp), intent(out) :: alphai(*),alphar(*),beta(*),work(*)
real(dp), intent(inout) :: h(ldh,*),q(ldq,*),t(ldt,*),z(ldz,*)
end subroutine dhgeqz
#else
module procedure stdlib${ii}$_dhgeqz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine shgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, &
beta, q, ldq, z, ldz, work,lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz,job
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldq,ldt,ldz,lwork,n
integer(${ik}$), intent(out) :: info
real(sp), intent(out) :: alphai(*),alphar(*),beta(*),work(*)
real(sp), intent(inout) :: h(ldh,*),q(ldq,*),t(ldt,*),z(ldz,*)
end subroutine shgeqz
#else
module procedure stdlib${ii}$_shgeqz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, &
ldq, z, ldz, work, lwork,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: compq,compz,job
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldq,ldt,ldz,lwork,n
integer(${ik}$), intent(out) :: info
real(dp), intent(out) :: rwork(*)
complex(dp), intent(out) :: alpha(*),beta(*),work(*)
complex(dp), intent(inout) :: h(ldh,*),q(ldq,*),t(ldt,*),z(ldz,*)
end subroutine zhgeqz
#else
module procedure stdlib${ii}$_zhgeqz
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hgeqz
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hgeqz
#:endif
#:endfor
#:endfor
end interface hgeqz
interface hpcon
!! HPCON estimates the reciprocal of the condition number of a complex
!! Hermitian packed matrix A using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHPTRF.
!! An estimate is obtained for norm(inv(A)), and the reciprocal of the
!! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
real(sp), intent(in) :: anorm
real(sp), intent(out) :: rcond
complex(sp), intent(in) :: ap(*)
complex(sp), intent(out) :: work(*)
end subroutine chpcon
#else
module procedure stdlib${ii}$_chpcon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhpcon( uplo, n, ap, ipiv, anorm, rcond, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
real(dp), intent(in) :: anorm
real(dp), intent(out) :: rcond
complex(dp), intent(in) :: ap(*)
complex(dp), intent(out) :: work(*)
end subroutine zhpcon
#else
module procedure stdlib${ii}$_zhpcon
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpcon
#:endif
#:endfor
#:endfor
end interface hpcon
interface hpev
!! HPEV computes all the eigenvalues and, optionally, eigenvectors of a
!! complex Hermitian matrix in packed storage.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldz,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chpev
#else
module procedure stdlib${ii}$_chpev
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldz,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhpev
#else
module procedure stdlib${ii}$_zhpev
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpev
#:endif
#:endfor
#:endfor
end interface hpev
interface hpevd
!! HPEVD computes all the eigenvalues and, optionally, eigenvectors of
!! a complex Hermitian matrix A in packed storage. If eigenvectors are
!! desired, it uses a divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, &
liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldz,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chpevd
#else
module procedure stdlib${ii}$_chpevd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, &
liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldz,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhpevd
#else
module procedure stdlib${ii}$_zhpevd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpevd
#:endif
#:endfor
#:endfor
end interface hpevd
interface hpgst
!! HPGST reduces a complex Hermitian-definite generalized
!! eigenproblem to standard form, using packed storage.
!! If ITYPE = 1, the problem is A*x = lambda*B*x,
!! and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H)
!! If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
!! B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H*A*L.
!! B must have been previously factorized as U**H*U or L*L**H by CPPTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chpgst( itype, uplo, n, ap, bp, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,n
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(in) :: bp(*)
end subroutine chpgst
#else
module procedure stdlib${ii}$_chpgst
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhpgst( itype, uplo, n, ap, bp, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,n
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(in) :: bp(*)
end subroutine zhpgst
#else
module procedure stdlib${ii}$_zhpgst
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpgst
#:endif
#:endfor
#:endfor
end interface hpgst
interface hpgv
!! HPGV computes all the eigenvalues and, optionally, the eigenvectors
!! of a complex generalized Hermitian-definite eigenproblem, of the form
!! A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
!! Here A and B are assumed to be Hermitian, stored in packed format,
!! and B is also positive definite.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,ldz,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ap(*),bp(*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chpgv
#else
module procedure stdlib${ii}$_chpgv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: itype,ldz,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ap(*),bp(*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhpgv
#else
module procedure stdlib${ii}$_zhpgv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpgv
#:endif
#:endfor
#:endfor
end interface hpgv
interface hpgvd
!! HPGVD computes all the eigenvalues and, optionally, the eigenvectors
!! of a complex generalized Hermitian-definite eigenproblem, of the form
!! A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
!! B are assumed to be Hermitian, stored in packed format, and B is also
!! positive definite.
!! If eigenvectors are desired, it uses a divide and conquer algorithm.
!! The divide and conquer algorithm makes very mild assumptions about
!! floating point arithmetic. It will work on machines with a guard
!! digit in add/subtract, or on those binary machines without guard
!! digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
!! Cray-2. It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: itype,ldz,liwork,lrwork,lwork,n
real(sp), intent(out) :: rwork(*),w(*)
complex(sp), intent(inout) :: ap(*),bp(*)
complex(sp), intent(out) :: work(*),z(ldz,*)
end subroutine chpgvd
#else
module procedure stdlib${ii}$_chpgvd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, &
lrwork, iwork, liwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobz,uplo
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: itype,ldz,liwork,lrwork,lwork,n
real(dp), intent(out) :: rwork(*),w(*)
complex(dp), intent(inout) :: ap(*),bp(*)
complex(dp), intent(out) :: work(*),z(ldz,*)
end subroutine zhpgvd
#else
module procedure stdlib${ii}$_zhpgvd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpgvd
#:endif
#:endfor
#:endfor
end interface hpgvd
interface hprfs
!! HPRFS improves the computed solution to a system of linear
!! equations when the coefficient matrix is Hermitian indefinite
!! and packed, and provides error bounds and backward error estimates
!! for the solution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, &
work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(sp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(sp), intent(in) :: afp(*),ap(*),b(ldb,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine chprfs
#else
module procedure stdlib${ii}$_chprfs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, &
work, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs,ipiv(*)
real(dp), intent(out) :: berr(*),ferr(*),rwork(*)
complex(dp), intent(in) :: afp(*),ap(*),b(ldb,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zhprfs
#else
module procedure stdlib${ii}$_zhprfs
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hprfs
#:endif
#:endfor
#:endfor
end interface hprfs
interface hpsv
!! HPSV computes the solution to a complex system of linear equations
!! A * X = B,
!! where A is an N-by-N Hermitian matrix stored in packed format and X
!! and B are N-by-NRHS matrices.
!! The diagonal pivoting method is used to factor A as
!! A = U * D * U**H, if UPLO = 'U', or
!! A = L * D * L**H, if UPLO = 'L',
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, D is Hermitian and block diagonal with 1-by-1
!! and 2-by-2 diagonal blocks. The factored form of A is then used to
!! solve the system of equations A * X = B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs
complex(sp), intent(inout) :: ap(*),b(ldb,*)
end subroutine chpsv
#else
module procedure stdlib${ii}$_chpsv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs
complex(dp), intent(inout) :: ap(*),b(ldb,*)
end subroutine zhpsv
#else
module procedure stdlib${ii}$_zhpsv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hpsv
#:endif
#:endfor
#:endfor
end interface hpsv
interface hptrd
!! HPTRD reduces a complex Hermitian matrix A stored in packed form to
!! real symmetric tridiagonal form T by a unitary similarity
!! transformation: Q**H * A * Q = T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chptrd( uplo, n, ap, d, e, tau, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(out) :: tau(*)
end subroutine chptrd
#else
module procedure stdlib${ii}$_chptrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhptrd( uplo, n, ap, d, e, tau, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(out) :: tau(*)
end subroutine zhptrd
#else
module procedure stdlib${ii}$_zhptrd
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hptrd
#:endif
#:endfor
#:endfor
end interface hptrd
interface hptrf
!! HPTRF computes the factorization of a complex Hermitian packed
!! matrix A using the Bunch-Kaufman diagonal pivoting method:
!! A = U*D*U**H or A = L*D*L**H
!! where U (or L) is a product of permutation and unit upper (lower)
!! triangular matrices, and D is Hermitian and block diagonal with
!! 1-by-1 and 2-by-2 diagonal blocks.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chptrf( uplo, n, ap, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
complex(sp), intent(inout) :: ap(*)
end subroutine chptrf
#else
module procedure stdlib${ii}$_chptrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhptrf( uplo, n, ap, ipiv, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,ipiv(*)
integer(${ik}$), intent(in) :: n
complex(dp), intent(inout) :: ap(*)
end subroutine zhptrf
#else
module procedure stdlib${ii}$_zhptrf
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hptrf
#:endif
#:endfor
#:endfor
end interface hptrf
interface hptri
!! HPTRI computes the inverse of a complex Hermitian indefinite matrix
!! A in packed storage using the factorization A = U*D*U**H or
!! A = L*D*L**H computed by CHPTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chptri( uplo, n, ap, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
complex(sp), intent(inout) :: ap(*)
complex(sp), intent(out) :: work(*)
end subroutine chptri
#else
module procedure stdlib${ii}$_chptri
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhptri( uplo, n, ap, ipiv, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n,ipiv(*)
complex(dp), intent(inout) :: ap(*)
complex(dp), intent(out) :: work(*)
end subroutine zhptri
#else
module procedure stdlib${ii}$_zhptri
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hptri
#:endif
#:endfor
#:endfor
end interface hptri
interface hptrs
!! HPTRS solves a system of linear equations A*X = B with a complex
!! Hermitian matrix A stored in packed format using the factorization
!! A = U*D*U**H or A = L*D*L**H computed by CHPTRF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
complex(sp), intent(in) :: ap(*)
complex(sp), intent(inout) :: b(ldb,*)
end subroutine chptrs
#else
module procedure stdlib${ii}$_chptrs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,n,nrhs,ipiv(*)
complex(dp), intent(in) :: ap(*)
complex(dp), intent(inout) :: b(ldb,*)
end subroutine zhptrs
#else
module procedure stdlib${ii}$_zhptrs
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hptrs
#:endif
#:endfor
#:endfor
end interface hptrs
interface hsein
!! HSEIN uses inverse iteration to find specified right and/or left
!! eigenvectors of a complex upper Hessenberg matrix H.
!! The right eigenvector x and the left eigenvector y of the matrix H
!! corresponding to an eigenvalue w are defined by:
!! H * x = w * x, y**h * H = w * y**h
!! where y**h denotes the conjugate transpose of the vector y.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, &
mm, m, work, rwork, ifaill,ifailr, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: eigsrc,initv,side
integer(${ik}$), intent(out) :: info,m,ifaill(*),ifailr(*)
integer(${ik}$), intent(in) :: ldh,ldvl,ldvr,mm,n
logical(lk), intent(in) :: select(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(in) :: h(ldh,*)
complex(sp), intent(inout) :: vl(ldvl,*),vr(ldvr,*),w(*)
complex(sp), intent(out) :: work(*)
end subroutine chsein
#else
module procedure stdlib${ii}$_chsein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, &
ldvr, mm, m, work, ifaill,ifailr, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: eigsrc,initv,side
integer(${ik}$), intent(out) :: info,m,ifaill(*),ifailr(*)
integer(${ik}$), intent(in) :: ldh,ldvl,ldvr,mm,n
logical(lk), intent(inout) :: select(*)
real(dp), intent(in) :: h(ldh,*),wi(*)
real(dp), intent(inout) :: vl(ldvl,*),vr(ldvr,*),wr(*)
real(dp), intent(out) :: work(*)
end subroutine dhsein
#else
module procedure stdlib${ii}$_dhsein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine shsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, &
ldvr, mm, m, work, ifaill,ifailr, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: eigsrc,initv,side
integer(${ik}$), intent(out) :: info,m,ifaill(*),ifailr(*)
integer(${ik}$), intent(in) :: ldh,ldvl,ldvr,mm,n
logical(lk), intent(inout) :: select(*)
real(sp), intent(in) :: h(ldh,*),wi(*)
real(sp), intent(inout) :: vl(ldvl,*),vr(ldvr,*),wr(*)
real(sp), intent(out) :: work(*)
end subroutine shsein
#else
module procedure stdlib${ii}$_shsein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zhsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, &
mm, m, work, rwork, ifaill,ifailr, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: eigsrc,initv,side
integer(${ik}$), intent(out) :: info,m,ifaill(*),ifailr(*)
integer(${ik}$), intent(in) :: ldh,ldvl,ldvr,mm,n
logical(lk), intent(in) :: select(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(in) :: h(ldh,*)
complex(dp), intent(inout) :: vl(ldvl,*),vr(ldvr,*),w(*)
complex(dp), intent(out) :: work(*)
end subroutine zhsein
#else
module procedure stdlib${ii}$_zhsein
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hsein
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hsein
#:endif
#:endfor
#:endfor
end interface hsein
interface hseqr
!! HSEQR computes the eigenvalues of a Hessenberg matrix H
!! and, optionally, the matrices T and Z from the Schur decomposition
!! H = Z T Z**H, where T is an upper triangular matrix (the
!! Schur form), and Z is the unitary matrix of Schur vectors.
!! Optionally Z may be postmultiplied into an input unitary
!! matrix Q so that this routine can give the Schur factorization
!! of a matrix A which has been reduced to the Hessenberg form H
!! by the unitary matrix Q: A = Q*H*Q**H = (QZ)*T*(QZ)**H.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
character, intent(in) :: compz,job
complex(sp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(sp), intent(out) :: w(*),work(*)
end subroutine chseqr
#else
module procedure stdlib${ii}$_chseqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
character, intent(in) :: compz,job
real(dp), intent(inout) :: h(ldh,*),z(ldz,*)
real(dp), intent(out) :: wi(*),work(*),wr(*)
end subroutine dhseqr
#else
module procedure stdlib${ii}$_dhseqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine shseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
character, intent(in) :: compz,job
real(sp), intent(inout) :: h(ldh,*),z(ldz,*)
real(sp), intent(out) :: wi(*),work(*),wr(*)
end subroutine shseqr
#else
module procedure stdlib${ii}$_shseqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zhseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ilo,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
character, intent(in) :: compz,job
complex(dp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(dp), intent(out) :: w(*),work(*)
end subroutine zhseqr
#else
module procedure stdlib${ii}$_zhseqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hseqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$hseqr
#:endif
#:endfor
#:endfor
end interface hseqr
interface isnan
!! ISNAN returns .TRUE. if its argument is NaN, and .FALSE.
!! otherwise. To be replaced by the Fortran 2003 intrinsic in the
!! future.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure logical(lk) function disnan( din )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: din
end function disnan
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_disnan
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure logical(lk) function sisnan( sin )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: sin
end function sisnan
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_sisnan
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$isnan
#:endif
#:endfor
end interface isnan
interface la_gbamv
!! LA_GBAMV performs one of the matrix-vector operations
!! y := alpha*abs(A)*abs(x) + beta*abs(y),
!! or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
!! where alpha and beta are scalars, x and y are vectors and A is an
!! m by n matrix.
!! This function is primarily used in calculating error bounds.
!! To protect against underflow during evaluation, components in
!! the resulting vector are perturbed away from zero by (N+1)
!! times the underflow threshold. To prevent unnecessarily large
!! errors for block-structure embedded in general matrices,
!! "symbolically" zero components are not perturbed. A zero
!! entry is considered "symbolic" if all multiplications involved
!! in computing that entry have at least one zero multiplicand.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,ldab,m,n,kl,ku,trans
complex(sp), intent(in) :: ab(ldab,*),x(*)
real(sp), intent(inout) :: y(*)
end subroutine cla_gbamv
#else
module procedure stdlib${ii}$_cla_gbamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta,ab(ldab,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,ldab,m,n,kl,ku,trans
real(dp), intent(inout) :: y(*)
end subroutine dla_gbamv
#else
module procedure stdlib${ii}$_dla_gbamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta,ab(ldab,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,ldab,m,n,kl,ku,trans
real(sp), intent(inout) :: y(*)
end subroutine sla_gbamv
#else
module procedure stdlib${ii}$_sla_gbamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,ldab,m,n,kl,ku,trans
complex(dp), intent(in) :: ab(ldab,*),x(*)
real(dp), intent(inout) :: y(*)
end subroutine zla_gbamv
#else
module procedure stdlib${ii}$_zla_gbamv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbamv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbamv
#:endif
#:endfor
#:endfor
end interface la_gbamv
interface la_gbrcond
!! LA_GBRCOND Estimates the Skeel condition number of op(A) * op2(C)
!! where op2 is determined by CMODE as follows
!! CMODE = 1 op2(C) = C
!! CMODE = 0 op2(C) = I
!! CMODE = -1 op2(C) = inv(C)
!! The Skeel condition number cond(A) = norminf( |inv(A)||A| )
!! is computed by computing scaling factors R such that
!! diag(R)*A*op2(C) is row equilibrated and computing the standard
!! infinity-norm condition number.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, &
c,info, work, iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: n,ldab,ldafb,kl,ku,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: ab(ldab,*),afb(ldafb,*),c(*)
real(dp), intent(out) :: work(*)
end function dla_gbrcond
#else
module procedure stdlib${ii}$_dla_gbrcond
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_gbrcond( trans, n, kl, ku, ab, ldab, afb, ldafb,ipiv, cmode, &
c, info, work, iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: n,ldab,ldafb,kl,ku,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: ab(ldab,*),afb(ldafb,*),c(*)
real(sp), intent(out) :: work(*)
end function sla_gbrcond
#else
module procedure stdlib${ii}$_sla_gbrcond
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbrcond
#:endif
#:endfor
#:endfor
end interface la_gbrcond
interface la_gbrcond_c
!! LA_GBRCOND_C Computes the infinity norm condition number of
!! op(A) * inv(diag(C)) where C is a REAL vector.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,ldafb, ipiv, c, &
capply, info, work,rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,kl,ku,ldab,ldafb,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: ab(ldab,*),afb(ldafb,*)
complex(sp), intent(out) :: work(*)
real(sp), intent(in) :: c(*)
real(sp), intent(out) :: rwork(*)
end function cla_gbrcond_c
#else
module procedure stdlib${ii}$_cla_gbrcond_c
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_gbrcond_c( trans, n, kl, ku, ab,ldab, afb, ldafb, ipiv,c, &
capply, info, work,rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,kl,ku,ldab,ldafb,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: ab(ldab,*),afb(ldafb,*)
complex(dp), intent(out) :: work(*)
real(dp), intent(in) :: c(*)
real(dp), intent(out) :: rwork(*)
end function zla_gbrcond_c
#else
module procedure stdlib${ii}$_zla_gbrcond_c
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbrcond_c
#:endif
#:endfor
#:endfor
end interface la_gbrcond_c
interface la_gbrpvgrw
!! LA_GBRPVGRW computes the reciprocal pivot growth factor
!! norm(A)/norm(U). The "max absolute element" norm is used. If this is
!! much less than 1, the stability of the LU factorization of the
!! (equilibrated) matrix A could be poor. This also means that the
!! solution X, estimated condition numbers, and error bounds could be
!! unreliable.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,kl,ku,ncols,ldab,ldafb
complex(sp), intent(in) :: ab(ldab,*),afb(ldafb,*)
end function cla_gbrpvgrw
#else
module procedure stdlib${ii}$_cla_gbrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function dla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,kl,ku,ncols,ldab,ldafb
real(dp), intent(in) :: ab(ldab,*),afb(ldafb,*)
end function dla_gbrpvgrw
#else
module procedure stdlib${ii}$_dla_gbrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function sla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,kl,ku,ncols,ldab,ldafb
real(sp), intent(in) :: ab(ldab,*),afb(ldafb,*)
end function sla_gbrpvgrw
#else
module procedure stdlib${ii}$_sla_gbrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function zla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,kl,ku,ncols,ldab,ldafb
complex(dp), intent(in) :: ab(ldab,*),afb(ldafb,*)
end function zla_gbrpvgrw
#else
module procedure stdlib${ii}$_zla_gbrpvgrw
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbrpvgrw
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gbrpvgrw
#:endif
#:endfor
#:endfor
end interface la_gbrpvgrw
interface la_geamv
!! LA_GEAMV performs one of the matrix-vector operations
!! y := alpha*abs(A)*abs(x) + beta*abs(y),
!! or y := alpha*abs(A)**T*abs(x) + beta*abs(y),
!! where alpha and beta are scalars, x and y are vectors and A is an
!! m by n matrix.
!! This function is primarily used in calculating error bounds.
!! To protect against underflow during evaluation, components in
!! the resulting vector are perturbed away from zero by (N+1)
!! times the underflow threshold. To prevent unnecessarily large
!! errors for block-structure embedded in general matrices,
!! "symbolically" zero components are not perturbed. A zero
!! entry is considered "symbolic" if all multiplications involved
!! in computing that entry have at least one zero multiplicand.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,m,n,trans
complex(sp), intent(in) :: a(lda,*),x(*)
real(sp), intent(inout) :: y(*)
end subroutine cla_geamv
#else
module procedure stdlib${ii}$_cla_geamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n,trans
real(dp), intent(inout) :: y(*)
end subroutine dla_geamv
#else
module procedure stdlib${ii}$_dla_geamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,m,n,trans
real(sp), intent(inout) :: y(*)
end subroutine sla_geamv
#else
module procedure stdlib${ii}$_sla_geamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,m,n,trans
complex(dp), intent(in) :: a(lda,*),x(*)
real(dp), intent(inout) :: y(*)
end subroutine zla_geamv
#else
module procedure stdlib${ii}$_zla_geamv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_geamv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_geamv
#:endif
#:endfor
#:endfor
end interface la_geamv
interface la_gercond
!! LA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
!! where op2 is determined by CMODE as follows
!! CMODE = 1 op2(C) = C
!! CMODE = 0 op2(C) = I
!! CMODE = -1 op2(C) = inv(C)
!! The Skeel condition number cond(A) = norminf( |inv(A)||A| )
!! is computed by computing scaling factors R such that
!! diag(R)*A*op2(C) is row equilibrated and computing the standard
!! infinity-norm condition number.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, &
work, iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(dp), intent(out) :: work(*)
end function dla_gercond
#else
module procedure stdlib${ii}$_dla_gercond
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_gercond( trans, n, a, lda, af, ldaf, ipiv,cmode, c, info, &
work, iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(sp), intent(out) :: work(*)
end function sla_gercond
#else
module procedure stdlib${ii}$_sla_gercond
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gercond
#:endif
#:endfor
#:endfor
end interface la_gercond
interface la_gercond_c
!! LA_GERCOND_C computes the infinity norm condition number of
!! op(A) * inv(diag(C)) where C is a REAL vector.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv, c,capply, info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
complex(sp), intent(out) :: work(*)
real(sp), intent(in) :: c(*)
real(sp), intent(out) :: rwork(*)
end function cla_gercond_c
#else
module procedure stdlib${ii}$_cla_gercond_c
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_gercond_c( trans, n, a, lda, af,ldaf, ipiv, c, capply,info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
complex(dp), intent(out) :: work(*)
real(dp), intent(in) :: c(*)
real(dp), intent(out) :: rwork(*)
end function zla_gercond_c
#else
module procedure stdlib${ii}$_zla_gercond_c
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gercond_c
#:endif
#:endfor
#:endfor
end interface la_gercond_c
interface la_gerpvgrw
!! LA_GERPVGRW computes the reciprocal pivot growth factor
!! norm(A)/norm(U). The "max absolute element" norm is used. If this is
!! much less than 1, the stability of the LU factorization of the
!! (equilibrated) matrix A could be poor. This also means that the
!! solution X, estimated condition numbers, and error bounds could be
!! unreliable.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function cla_gerpvgrw( n, ncols, a, lda, af, ldaf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,ncols,lda,ldaf
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
end function cla_gerpvgrw
#else
module procedure stdlib${ii}$_cla_gerpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function dla_gerpvgrw( n, ncols, a, lda, af,ldaf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,ncols,lda,ldaf
real(dp), intent(in) :: a(lda,*),af(ldaf,*)
end function dla_gerpvgrw
#else
module procedure stdlib${ii}$_dla_gerpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function sla_gerpvgrw( n, ncols, a, lda, af, ldaf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,ncols,lda,ldaf
real(sp), intent(in) :: a(lda,*),af(ldaf,*)
end function sla_gerpvgrw
#else
module procedure stdlib${ii}$_sla_gerpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function zla_gerpvgrw( n, ncols, a, lda, af,ldaf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,ncols,lda,ldaf
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
end function zla_gerpvgrw
#else
module procedure stdlib${ii}$_zla_gerpvgrw
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gerpvgrw
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_gerpvgrw
#:endif
#:endfor
#:endfor
end interface la_gerpvgrw
interface la_heamv
!! CLA_SYAMV performs the matrix-vector operation
!! y := alpha*abs(A)*abs(x) + beta*abs(y),
!! where alpha and beta are scalars, x and y are vectors and A is an
!! n by n symmetric matrix.
!! This function is primarily used in calculating error bounds.
!! To protect against underflow during evaluation, components in
!! the resulting vector are perturbed away from zero by (N+1)
!! times the underflow threshold. To prevent unnecessarily large
!! errors for block-structure embedded in general matrices,
!! "symbolically" zero components are not perturbed. A zero
!! entry is considered "symbolic" if all multiplications involved
!! in computing that entry have at least one zero multiplicand.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
complex(sp), intent(in) :: a(lda,*),x(*)
real(sp), intent(inout) :: y(*)
end subroutine cla_heamv
#else
module procedure stdlib${ii}$_cla_heamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
complex(dp), intent(in) :: a(lda,*),x(*)
real(dp), intent(inout) :: y(*)
end subroutine zla_heamv
#else
module procedure stdlib${ii}$_zla_heamv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_heamv
#:endif
#:endfor
#:endfor
end interface la_heamv
interface la_hercond_c
!! LA_HERCOND_C computes the infinity norm condition number of
!! op(A) * inv(diag(C)) where C is a REAL vector.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_hercond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
complex(sp), intent(out) :: work(*)
real(sp), intent(in) :: c(*)
real(sp), intent(out) :: rwork(*)
end function cla_hercond_c
#else
module procedure stdlib${ii}$_cla_hercond_c
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_hercond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
complex(dp), intent(out) :: work(*)
real(dp), intent(in) :: c(*)
real(dp), intent(out) :: rwork(*)
end function zla_hercond_c
#else
module procedure stdlib${ii}$_zla_hercond_c
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_hercond_c
#:endif
#:endfor
#:endfor
end interface la_hercond_c
interface la_herpvgrw
!! LA_HERPVGRW computes the reciprocal pivot growth factor
!! norm(A)/norm(U). The "max absolute element" norm is used. If this is
!! much less than 1, the stability of the LU factorization of the
!! (equilibrated) matrix A could be poor. This also means that the
!! solution X, estimated condition numbers, and error bounds could be
!! unreliable.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
real(sp), intent(out) :: work(*)
end function cla_herpvgrw
#else
module procedure stdlib${ii}$_cla_herpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
real(dp), intent(out) :: work(*)
end function zla_herpvgrw
#else
module procedure stdlib${ii}$_zla_herpvgrw
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_herpvgrw
#:endif
#:endfor
#:endfor
end interface la_herpvgrw
interface la_lin_berr
!! LA_LIN_BERR computes componentwise relative backward error from
!! the formula
!! max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
!! where abs(Z) is the componentwise absolute value of the matrix
!! or vector Z.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cla_lin_berr( n, nz, nrhs, res, ayb, berr )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,nz,nrhs
real(sp), intent(in) :: ayb(n,nrhs)
real(sp), intent(out) :: berr(nrhs)
complex(sp), intent(in) :: res(n,nrhs)
end subroutine cla_lin_berr
#else
module procedure stdlib${ii}$_cla_lin_berr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dla_lin_berr ( n, nz, nrhs, res, ayb, berr )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,nz,nrhs
real(dp), intent(in) :: ayb(n,nrhs),res(n,nrhs)
real(dp), intent(out) :: berr(nrhs)
end subroutine dla_lin_berr
#else
module procedure stdlib${ii}$_dla_lin_berr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sla_lin_berr( n, nz, nrhs, res, ayb, berr )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,nz,nrhs
real(sp), intent(in) :: ayb(n,nrhs),res(n,nrhs)
real(sp), intent(out) :: berr(nrhs)
end subroutine sla_lin_berr
#else
module procedure stdlib${ii}$_sla_lin_berr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zla_lin_berr( n, nz, nrhs, res, ayb, berr )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,nz,nrhs
real(dp), intent(in) :: ayb(n,nrhs)
real(dp), intent(out) :: berr(nrhs)
complex(dp), intent(in) :: res(n,nrhs)
end subroutine zla_lin_berr
#else
module procedure stdlib${ii}$_zla_lin_berr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_lin_berr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_lin_berr
#:endif
#:endfor
#:endfor
end interface la_lin_berr
interface la_porcond
!! LA_PORCOND Estimates the Skeel condition number of op(A) * op2(C)
!! where op2 is determined by CMODE as follows
!! CMODE = 1 op2(C) = C
!! CMODE = 0 op2(C) = I
!! CMODE = -1 op2(C) = inv(C)
!! The Skeel condition number cond(A) = norminf( |inv(A)||A| )
!! is computed by computing scaling factors R such that
!! diag(R)*A*op2(C) is row equilibrated and computing the standard
!! infinity-norm condition number.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,&
iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(dp), intent(out) :: work(*)
end function dla_porcond
#else
module procedure stdlib${ii}$_dla_porcond
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_porcond( uplo, n, a, lda, af, ldaf, cmode, c,info, work, &
iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(sp), intent(out) :: work(*)
end function sla_porcond
#else
module procedure stdlib${ii}$_sla_porcond
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_porcond
#:endif
#:endfor
#:endfor
end interface la_porcond
interface la_porcond_c
!! LA_PORCOND_C Computes the infinity norm condition number of
!! op(A) * inv(diag(C)) where C is a REAL vector
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_porcond_c( uplo, n, a, lda, af, ldaf, c, capply,info, work, &
rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
complex(sp), intent(out) :: work(*)
real(sp), intent(in) :: c(*)
real(sp), intent(out) :: rwork(*)
end function cla_porcond_c
#else
module procedure stdlib${ii}$_cla_porcond_c
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_porcond_c( uplo, n, a, lda, af,ldaf, c, capply, info,work, &
rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
complex(dp), intent(out) :: work(*)
real(dp), intent(in) :: c(*)
real(dp), intent(out) :: rwork(*)
end function zla_porcond_c
#else
module procedure stdlib${ii}$_zla_porcond_c
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_porcond_c
#:endif
#:endfor
#:endfor
end interface la_porcond_c
interface la_porpvgrw
!! LA_PORPVGRW computes the reciprocal pivot growth factor
!! norm(A)/norm(U). The "max absolute element" norm is used. If this is
!! much less than 1, the stability of the LU factorization of the
!! (equilibrated) matrix A could be poor. This also means that the
!! solution X, estimated condition numbers, and error bounds could be
!! unreliable.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: ncols,lda,ldaf
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
real(sp), intent(out) :: work(*)
end function cla_porpvgrw
#else
module procedure stdlib${ii}$_cla_porpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: ncols,lda,ldaf
real(dp), intent(in) :: a(lda,*),af(ldaf,*)
real(dp), intent(out) :: work(*)
end function dla_porpvgrw
#else
module procedure stdlib${ii}$_dla_porpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: ncols,lda,ldaf
real(sp), intent(in) :: a(lda,*),af(ldaf,*)
real(sp), intent(out) :: work(*)
end function sla_porpvgrw
#else
module procedure stdlib${ii}$_sla_porpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: ncols,lda,ldaf
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
real(dp), intent(out) :: work(*)
end function zla_porpvgrw
#else
module procedure stdlib${ii}$_zla_porpvgrw
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_porpvgrw
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_porpvgrw
#:endif
#:endfor
#:endfor
end interface la_porpvgrw
interface la_syamv
!! LA_SYAMV performs the matrix-vector operation
!! y := alpha*abs(A)*abs(x) + beta*abs(y),
!! where alpha and beta are scalars, x and y are vectors and A is an
!! n by n symmetric matrix.
!! This function is primarily used in calculating error bounds.
!! To protect against underflow during evaluation, components in
!! the resulting vector are perturbed away from zero by (N+1)
!! times the underflow threshold. To prevent unnecessarily large
!! errors for block-structure embedded in general matrices,
!! "symbolically" zero components are not perturbed. A zero
!! entry is considered "symbolic" if all multiplications involved
!! in computing that entry have at least one zero multiplicand.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
complex(sp), intent(in) :: a(lda,*),x(*)
real(sp), intent(inout) :: y(*)
end subroutine cla_syamv
#else
module procedure stdlib${ii}$_cla_syamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
real(dp), intent(inout) :: y(*)
end subroutine dla_syamv
#else
module procedure stdlib${ii}$_dla_syamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine sla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: alpha,beta,a(lda,*),x(*)
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
real(sp), intent(inout) :: y(*)
end subroutine sla_syamv
#else
module procedure stdlib${ii}$_sla_syamv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: alpha,beta
integer(${ik}$), intent(in) :: incx,incy,lda,n,uplo
complex(dp), intent(in) :: a(lda,*),x(*)
real(dp), intent(inout) :: y(*)
end subroutine zla_syamv
#else
module procedure stdlib${ii}$_zla_syamv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syamv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syamv
#:endif
#:endfor
#:endfor
end interface la_syamv
interface la_syrcond
!! LA_SYRCOND estimates the Skeel condition number of op(A) * op2(C)
!! where op2 is determined by CMODE as follows
!! CMODE = 1 op2(C) = C
!! CMODE = 0 op2(C) = I
!! CMODE = -1 op2(C) = inv(C)
!! The Skeel condition number cond(A) = norminf( |inv(A)||A| )
!! is computed by computing scaling factors R such that
!! diag(R)*A*op2(C) is row equilibrated and computing the standard
!! infinity-norm condition number.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, &
work,iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(dp), intent(out) :: work(*)
end function dla_syrcond
#else
module procedure stdlib${ii}$_dla_syrcond
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv, cmode,c, info, &
work, iwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,lda,ldaf,cmode,ipiv(*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: a(lda,*),af(ldaf,*),c(*)
real(sp), intent(out) :: work(*)
end function sla_syrcond
#else
module procedure stdlib${ii}$_sla_syrcond
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syrcond
#:endif
#:endfor
#:endfor
end interface la_syrcond
interface la_syrcond_c
!! LA_SYRCOND_C Computes the infinity norm condition number of
!! op(A) * inv(diag(C)) where C is a REAL vector.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
complex(sp), intent(out) :: work(*)
real(sp), intent(in) :: c(*)
real(sp), intent(out) :: rwork(*)
end function cla_syrcond_c
#else
module procedure stdlib${ii}$_cla_syrcond_c
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_syrcond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, &
work, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
logical(lk), intent(in) :: capply
integer(${ik}$), intent(in) :: n,lda,ldaf,ipiv(*)
integer(${ik}$), intent(out) :: info
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
complex(dp), intent(out) :: work(*)
real(dp), intent(in) :: c(*)
real(dp), intent(out) :: rwork(*)
end function zla_syrcond_c
#else
module procedure stdlib${ii}$_zla_syrcond_c
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syrcond_c
#:endif
#:endfor
#:endfor
end interface la_syrcond_c
interface la_syrpvgrw
!! LA_SYRPVGRW computes the reciprocal pivot growth factor
!! norm(A)/norm(U). The "max absolute element" norm is used. If this is
!! much less than 1, the stability of the LU factorization of the
!! (equilibrated) matrix A could be poor. This also means that the
!! solution X, estimated condition numbers, and error bounds could be
!! unreliable.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
complex(sp), intent(in) :: a(lda,*),af(ldaf,*)
real(sp), intent(out) :: work(*)
end function cla_syrpvgrw
#else
module procedure stdlib${ii}$_cla_syrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
real(dp), intent(in) :: a(lda,*),af(ldaf,*)
real(dp), intent(out) :: work(*)
end function dla_syrpvgrw
#else
module procedure stdlib${ii}$_dla_syrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
real(sp), intent(in) :: a(lda,*),af(ldaf,*)
real(sp), intent(out) :: work(*)
end function sla_syrpvgrw
#else
module procedure stdlib${ii}$_sla_syrpvgrw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n,info,lda,ldaf,ipiv(*)
complex(dp), intent(in) :: a(lda,*),af(ldaf,*)
real(dp), intent(out) :: work(*)
end function zla_syrpvgrw
#else
module procedure stdlib${ii}$_zla_syrpvgrw
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syrpvgrw
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_syrpvgrw
#:endif
#:endfor
#:endfor
end interface la_syrpvgrw
interface la_wwaddw
!! LA_WWADDW adds a vector W into a doubled-single vector (X, Y).
!! This works for all extant IBM's hex and binary floating point
!! arithmetic, but not for decimal.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine cla_wwaddw( n, x, y, w )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
complex(sp), intent(inout) :: x(*),y(*)
complex(sp), intent(in) :: w(*)
end subroutine cla_wwaddw
#else
module procedure stdlib${ii}$_cla_wwaddw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dla_wwaddw( n, x, y, w )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: x(*),y(*)
real(dp), intent(in) :: w(*)
end subroutine dla_wwaddw
#else
module procedure stdlib${ii}$_dla_wwaddw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sla_wwaddw( n, x, y, w )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: x(*),y(*)
real(sp), intent(in) :: w(*)
end subroutine sla_wwaddw
#else
module procedure stdlib${ii}$_sla_wwaddw
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zla_wwaddw( n, x, y, w )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
complex(dp), intent(inout) :: x(*),y(*)
complex(dp), intent(in) :: w(*)
end subroutine zla_wwaddw
#else
module procedure stdlib${ii}$_zla_wwaddw
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_wwaddw
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$la_wwaddw
#:endif
#:endfor
#:endfor
end interface la_wwaddw
interface labad
!! LABAD takes as input the values computed by DLAMCH for underflow and
!! overflow, and returns the square root of each of these values if the
!! log of LARGE is sufficiently large. This subroutine is intended to
!! identify machines with a large exponent range, such as the Crays, and
!! redefine the underflow and overflow limits to be the square roots of
!! the values computed by DLAMCH. This subroutine is needed because
!! DLAMCH does not compensate for poor arithmetic in the upper half of
!! the exponent range, as is found on a Cray.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlabad( small, large )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(inout) :: large,small
end subroutine dlabad
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_dlabad
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slabad( small, large )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(inout) :: large,small
end subroutine slabad
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_slabad
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$labad
#:endif
#:endfor
end interface labad
interface labrd
!! LABRD reduces the first NB rows and columns of a complex general
!! m by n matrix A to upper or lower real bidiagonal form by a unitary
!! transformation Q**H * A * P, and returns the matrices X and Y which
!! are needed to apply the transformation to the unreduced part of A.
!! If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
!! bidiagonal form.
!! This is an auxiliary routine called by CGEBRD
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldx,ldy,m,n,nb
real(sp), intent(out) :: d(*),e(*)
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: taup(*),tauq(*),x(ldx,*),y(ldy,*)
end subroutine clabrd
#else
module procedure stdlib${ii}$_clabrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldx,ldy,m,n,nb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: d(*),e(*),taup(*),tauq(*),x(ldx,*),y(ldy,*)
end subroutine dlabrd
#else
module procedure stdlib${ii}$_dlabrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldx,ldy,m,n,nb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: d(*),e(*),taup(*),tauq(*),x(ldx,*),y(ldy,*)
end subroutine slabrd
#else
module procedure stdlib${ii}$_slabrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldx,ldy,m,n,nb
real(dp), intent(out) :: d(*),e(*)
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: taup(*),tauq(*),x(ldx,*),y(ldy,*)
end subroutine zlabrd
#else
module procedure stdlib${ii}$_zlabrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$labrd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$labrd
#:endif
#:endfor
#:endfor
end interface labrd
interface lacgv
!! LACGV conjugates a complex vector of length N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clacgv( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(inout) :: x(*)
end subroutine clacgv
#else
module procedure stdlib${ii}$_clacgv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlacgv( n, x, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(inout) :: x(*)
end subroutine zlacgv
#else
module procedure stdlib${ii}$_zlacgv
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacgv
#:endif
#:endfor
#:endfor
end interface lacgv
interface lacon
!! LACON estimates the 1-norm of a square, complex matrix A.
!! Reverse communication is used for evaluating matrix-vector products.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine clacon( n, v, x, est, kase )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(inout) :: kase
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: est
complex(sp), intent(out) :: v(n)
complex(sp), intent(inout) :: x(n)
end subroutine clacon
#else
module procedure stdlib${ii}$_clacon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlacon( n, v, x, isgn, est, kase )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(inout) :: kase
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: est,x(*)
integer(${ik}$), intent(out) :: isgn(*)
real(dp), intent(out) :: v(*)
end subroutine dlacon
#else
module procedure stdlib${ii}$_dlacon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slacon( n, v, x, isgn, est, kase )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(inout) :: kase
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: est,x(*)
integer(${ik}$), intent(out) :: isgn(*)
real(sp), intent(out) :: v(*)
end subroutine slacon
#else
module procedure stdlib${ii}$_slacon
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zlacon( n, v, x, est, kase )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(inout) :: kase
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: est
complex(dp), intent(out) :: v(n)
complex(dp), intent(inout) :: x(n)
end subroutine zlacon
#else
module procedure stdlib${ii}$_zlacon
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacon
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacon
#:endif
#:endfor
#:endfor
end interface lacon
interface lacpy
!! LACPY copies all or part of a two-dimensional matrix A to another
!! matrix B.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clacpy( uplo, m, n, a, lda, b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,ldb,m,n
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(out) :: b(ldb,*)
end subroutine clacpy
#else
module procedure stdlib${ii}$_clacpy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlacpy( uplo, m, n, a, lda, b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,ldb,m,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: b(ldb,*)
end subroutine dlacpy
#else
module procedure stdlib${ii}$_dlacpy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slacpy( uplo, m, n, a, lda, b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,ldb,m,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: b(ldb,*)
end subroutine slacpy
#else
module procedure stdlib${ii}$_slacpy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlacpy( uplo, m, n, a, lda, b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,ldb,m,n
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(out) :: b(ldb,*)
end subroutine zlacpy
#else
module procedure stdlib${ii}$_zlacpy
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacpy
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacpy
#:endif
#:endfor
#:endfor
end interface lacpy
interface lacrm
!! LACRM performs a very simple matrix-matrix multiplication:
!! C := A * B,
!! where A is M by N and complex; B is N by N and real;
!! C is M by N and complex.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clacrm( m, n, a, lda, b, ldb, c, ldc, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
real(sp), intent(in) :: b(ldb,*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(in) :: a(lda,*)
complex(sp), intent(out) :: c(ldc,*)
end subroutine clacrm
#else
module procedure stdlib${ii}$_clacrm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlacrm( m, n, a, lda, b, ldb, c, ldc, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
real(dp), intent(in) :: b(ldb,*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(in) :: a(lda,*)
complex(dp), intent(out) :: c(ldc,*)
end subroutine zlacrm
#else
module procedure stdlib${ii}$_zlacrm
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacrm
#:endif
#:endfor
#:endfor
end interface lacrm
interface lacrt
!! LACRT performs the operation
!! ( c s )( x ) ==> ( x )
!! ( -s c )( y ) ( y )
!! where c and s are complex and the vectors x and y are complex.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clacrt( n, cx, incx, cy, incy, c, s )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
complex(sp), intent(in) :: c,s
complex(sp), intent(inout) :: cx(*),cy(*)
end subroutine clacrt
#else
module procedure stdlib${ii}$_clacrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlacrt( n, cx, incx, cy, incy, c, s )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
complex(dp), intent(in) :: c,s
complex(dp), intent(inout) :: cx(*),cy(*)
end subroutine zlacrt
#else
module procedure stdlib${ii}$_zlacrt
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lacrt
#:endif
#:endfor
#:endfor
end interface lacrt
interface ladiv_f
!! LADIV_F := X / Y, where X and Y are complex. The computation of X / Y
!! will not overflow on an intermediary step unless the results
!! overflows.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure complex(sp) function cladiv( x, y )
import sp,dp,qp,${ik}$,lk
implicit none
complex(sp), intent(in) :: x,y
end function cladiv
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_cladiv
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure complex(dp) function zladiv( x, y )
import sp,dp,qp,${ik}$,lk
implicit none
complex(dp), intent(in) :: x,y
end function zladiv
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_zladiv
#:endif
#endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$ladiv
#:endif
#:endfor
end interface ladiv_f
interface ladiv_s
!! LADIV_S performs complex division in real arithmetic
!! a + i*b
!! p + i*q = ---------
!! c + i*d
!! The algorithm is due to Michael Baudin and Robert L. Smith
!! and can be found in the paper
!! "A Robust Complex Division in Scilab"
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dladiv( a, b, c, d, p, q )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: a,b,c,d
real(dp), intent(out) :: p,q
end subroutine dladiv
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_dladiv
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sladiv( a, b, c, d, p, q )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: a,b,c,d
real(sp), intent(out) :: p,q
end subroutine sladiv
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_sladiv
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$ladiv
#:endif
#:endfor
end interface ladiv_s
interface ladiv1
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dladiv1( a, b, c, d, p, q )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(inout) :: a
real(dp), intent(in) :: b,c,d
real(dp), intent(out) :: p,q
end subroutine dladiv1
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_dladiv1
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine sladiv1( a, b, c, d, p, q )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(inout) :: a
real(sp), intent(in) :: b,c,d
real(sp), intent(out) :: p,q
end subroutine sladiv1
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_sladiv1
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$ladiv1
#:endif
#:endfor
end interface ladiv1
interface ladiv2
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function dladiv2( a, b, c, d, r, t )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: a,b,c,d,r,t
end function dladiv2
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_dladiv2
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function sladiv2( a, b, c, d, r, t )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: a,b,c,d,r,t
end function sladiv2
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_sladiv2
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$ladiv2
#:endif
#:endfor
end interface ladiv2
interface laebz
!! LAEBZ contains the iteration loops which compute and use the
!! function N(w), which is the count of eigenvalues of a symmetric
!! tridiagonal matrix T less than or equal to its argument w. It
!! performs a choice of two types of loops:
!! IJOB=1, followed by
!! IJOB=2: It takes as input a list of intervals and returns a list of
!! sufficiently small intervals whose union contains the same
!! eigenvalues as the union of the original intervals.
!! The input intervals are (AB(j,1),AB(j,2)], j=1,...,MINP.
!! The output interval (AB(j,1),AB(j,2)] will contain
!! eigenvalues NAB(j,1)+1,...,NAB(j,2), where 1 <= j <= MOUT.
!! IJOB=3: It performs a binary search in each input interval
!! (AB(j,1),AB(j,2)] for a point w(j) such that
!! N(w(j))=NVAL(j), and uses C(j) as the starting point of
!! the search. If such a w(j) is found, then on output
!! AB(j,1)=AB(j,2)=w. If no such w(j) is found, then on output
!! (AB(j,1),AB(j,2)] will be a small interval containing the
!! point where N(w) jumps through NVAL(j), unless that point
!! lies outside the initial interval.
!! Note that the intervals are in all cases half-open intervals,
!! i.e., of the form (a,b] , which includes b but not a .
!! To avoid underflow, the matrix should be scaled so that its largest
!! element is no greater than overflow**(1/2) * underflow**(1/4)
!! in absolute value. To assure the most accurate computation
!! of small eigenvalues, the matrix should be scaled to be
!! not much smaller than that, either.
!! See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
!! Matrix", Report CS41, Computer Science Dept., Stanford
!! University, July 21, 1966
!! Note: the arguments are, in general, *not* checked for unreasonable
!! values.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, &
d, e, e2, nval, ab, c, mout,nab, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,minp,mmax,n,nbmin,nitmax
integer(${ik}$), intent(out) :: info,mout,iwork(*)
real(dp), intent(in) :: abstol,pivmin,reltol,d(*),e(*),e2(*)
integer(${ik}$), intent(inout) :: nab(mmax,*),nval(*)
real(dp), intent(inout) :: ab(mmax,*),c(*)
real(dp), intent(out) :: work(*)
end subroutine dlaebz
#else
module procedure stdlib${ii}$_dlaebz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, &
d, e, e2, nval, ab, c, mout,nab, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,minp,mmax,n,nbmin,nitmax
integer(${ik}$), intent(out) :: info,mout,iwork(*)
real(sp), intent(in) :: abstol,pivmin,reltol,d(*),e(*),e2(*)
integer(${ik}$), intent(inout) :: nab(mmax,*),nval(*)
real(sp), intent(inout) :: ab(mmax,*),c(*)
real(sp), intent(out) :: work(*)
end subroutine slaebz
#else
module procedure stdlib${ii}$_slaebz
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laebz
#:endif
#:endfor
#:endfor
end interface laebz
interface laed0
!! Using the divide and conquer method, LAED0: computes all eigenvalues
!! of a symmetric tridiagonal matrix which is one diagonal block of
!! those from reducing a dense or band Hermitian matrix and
!! corresponding eigenvectors of the dense or band matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldq,ldqs,n,qsiz
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: q(ldq,*)
complex(sp), intent(out) :: qstore(ldqs,*)
end subroutine claed0
#else
module procedure stdlib${ii}$_claed0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldq,ldqs,n,qsiz
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(inout) :: d(*),e(*),q(ldq,*)
real(dp), intent(out) :: qstore(ldqs,*),work(*)
end subroutine dlaed0
#else
module procedure stdlib${ii}$_dlaed0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldq,ldqs,n,qsiz
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(inout) :: d(*),e(*),q(ldq,*)
real(sp), intent(out) :: qstore(ldqs,*),work(*)
end subroutine slaed0
#else
module procedure stdlib${ii}$_slaed0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldq,ldqs,n,qsiz
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: q(ldq,*)
complex(dp), intent(out) :: qstore(ldqs,*)
end subroutine zlaed0
#else
module procedure stdlib${ii}$_zlaed0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed0
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed0
#:endif
#:endfor
#:endfor
end interface laed0
interface laed1
!! LAED1 computes the updated eigensystem of a diagonal
!! matrix after modification by a rank-one symmetric matrix. This
!! routine is used only for the eigenproblem which requires all
!! eigenvalues and eigenvectors of a tridiagonal matrix. DLAED7 handles
!! the case in which eigenvalues only or eigenvalues and eigenvectors
!! of a full symmetric matrix (which was reduced to tridiagonal form)
!! are desired.
!! T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
!! where Z = Q**T*u, u is a vector of length N with ones in the
!! CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
!! The eigenvectors of the original matrix are stored in Q, and the
!! eigenvalues are in D. The algorithm consists of three stages:
!! The first stage consists of deflating the size of the problem
!! when there are multiple eigenvalues or if there is a zero in
!! the Z vector. For each such occurrence the dimension of the
!! secular equation problem is reduced by one. This stage is
!! performed by the routine DLAED2.
!! The second stage consists of calculating the updated
!! eigenvalues. This is done by finding the roots of the secular
!! equation via the routine DLAED4 (as called by DLAED3).
!! This routine also calculates the eigenvectors of the current
!! problem.
!! The final stage consists of computing the updated eigenvectors
!! directly using the updated eigenvalues. The eigenvectors for
!! the current problem are multiplied with the eigenvectors from
!! the overall problem.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,ldq,n
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(inout) :: rho,d(*),q(ldq,*)
integer(${ik}$), intent(inout) :: indxq(*)
real(dp), intent(out) :: work(*)
end subroutine dlaed1
#else
module procedure stdlib${ii}$_dlaed1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,ldq,n
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(inout) :: rho,d(*),q(ldq,*)
integer(${ik}$), intent(inout) :: indxq(*)
real(sp), intent(out) :: work(*)
end subroutine slaed1
#else
module procedure stdlib${ii}$_slaed1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed1
#:endif
#:endfor
#:endfor
end interface laed1
interface laed4
!! This subroutine computes the I-th updated eigenvalue of a symmetric
!! rank-one modification to a diagonal matrix whose elements are
!! given in the array d, and that
!! D(i) < D(j) for i < j
!! and that RHO > 0. This is arranged by the calling routine, and is
!! no loss in generality. The rank-one modified system is thus
!! diag( D ) + RHO * Z * Z_transpose.
!! where we assume the Euclidean norm of Z is 1.
!! The method consists of approximating the rational functions in the
!! secular equation by simpler interpolating rational functions.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed4( n, i, d, z, delta, rho, dlam, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i,n
integer(${ik}$), intent(out) :: info
real(dp), intent(out) :: dlam,delta(*)
real(dp), intent(in) :: rho,d(*),z(*)
end subroutine dlaed4
#else
module procedure stdlib${ii}$_dlaed4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed4( n, i, d, z, delta, rho, dlam, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i,n
integer(${ik}$), intent(out) :: info
real(sp), intent(out) :: dlam,delta(*)
real(sp), intent(in) :: rho,d(*),z(*)
end subroutine slaed4
#else
module procedure stdlib${ii}$_slaed4
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed4
#:endif
#:endfor
#:endfor
end interface laed4
interface laed5
!! This subroutine computes the I-th eigenvalue of a symmetric rank-one
!! modification of a 2-by-2 diagonal matrix
!! diag( D ) + RHO * Z * transpose(Z) .
!! The diagonal elements in the array D are assumed to satisfy
!! D(i) < D(j) for i < j .
!! We also assume RHO > 0 and that the Euclidean norm of the vector
!! Z is one.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed5( i, d, z, delta, rho, dlam )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i
real(dp), intent(out) :: dlam,delta(2)
real(dp), intent(in) :: rho,d(2),z(2)
end subroutine dlaed5
#else
module procedure stdlib${ii}$_dlaed5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed5( i, d, z, delta, rho, dlam )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i
real(sp), intent(out) :: dlam,delta(2)
real(sp), intent(in) :: rho,d(2),z(2)
end subroutine slaed5
#else
module procedure stdlib${ii}$_slaed5
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed5
#:endif
#:endfor
#:endfor
end interface laed5
interface laed6
!! LAED6 computes the positive or negative root (closest to the origin)
!! of
!! z(1) z(2) z(3)
!! f(x) = rho + --------- + ---------- + ---------
!! d(1)-x d(2)-x d(3)-x
!! It is assumed that
!! if ORGATI = .true. the root is between d(2) and d(3);
!! otherwise it is between d(1) and d(2)
!! This routine will be called by DLAED4 when necessary. In most cases,
!! the root sought is the smallest in magnitude, though it might not be
!! in some extremely rare situations.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed6( kniter, orgati, rho, d, z, finit, tau, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: orgati
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kniter
real(dp), intent(in) :: finit,rho,d(3),z(3)
real(dp), intent(out) :: tau
end subroutine dlaed6
#else
module procedure stdlib${ii}$_dlaed6
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed6( kniter, orgati, rho, d, z, finit, tau, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: orgati
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kniter
real(sp), intent(in) :: finit,rho,d(3),z(3)
real(sp), intent(out) :: tau
end subroutine slaed6
#else
module procedure stdlib${ii}$_slaed6
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed6
#:endif
#:endfor
#:endfor
end interface laed6
interface laed7
!! LAED7 computes the updated eigensystem of a diagonal
!! matrix after modification by a rank-one symmetric matrix. This
!! routine is used only for the eigenproblem which requires all
!! eigenvalues and optionally eigenvectors of a dense or banded
!! Hermitian matrix that has been reduced to tridiagonal form.
!! T = Q(in) ( D(in) + RHO * Z*Z**H ) Q**H(in) = Q(out) * D(out) * Q**H(out)
!! where Z = Q**Hu, u is a vector of length N with ones in the
!! CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
!! The eigenvectors of the original matrix are stored in Q, and the
!! eigenvalues are in D. The algorithm consists of three stages:
!! The first stage consists of deflating the size of the problem
!! when there are multiple eigenvalues or if there is a zero in
!! the Z vector. For each such occurrence the dimension of the
!! secular equation problem is reduced by one. This stage is
!! performed by the routine SLAED2.
!! The second stage consists of calculating the updated
!! eigenvalues. This is done by finding the roots of the secular
!! equation via the routine SLAED4 (as called by SLAED3).
!! This routine also calculates the eigenvectors of the current
!! problem.
!! The final stage consists of computing the updated eigenvectors
!! directly using the updated eigenvalues. The eigenvectors for
!! the current problem are multiplied with the eigenvectors from
!! the overall problem.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, &
indxq, qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,cutpnt,ldq,n,qsiz,tlvls
integer(${ik}$), intent(out) :: info,indxq(*),iwork(*)
real(sp), intent(inout) :: rho,d(*),givnum(2,*),qstore(*)
integer(${ik}$), intent(inout) :: givcol(2,*),givptr(*),perm(*),prmptr(*),qptr(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: q(ldq,*)
complex(sp), intent(out) :: work(*)
end subroutine claed7
#else
module procedure stdlib${ii}$_claed7
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, &
rho, cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,cutpnt,icompq,ldq,n,qsiz,&
tlvls
integer(${ik}$), intent(out) :: info,indxq(*),iwork(*)
real(dp), intent(inout) :: rho,d(*),givnum(2,*),q(ldq,*),qstore(*)
integer(${ik}$), intent(inout) :: givcol(2,*),givptr(*),perm(*),prmptr(*),qptr(*)
real(dp), intent(out) :: work(*)
end subroutine dlaed7
#else
module procedure stdlib${ii}$_dlaed7
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, &
rho, cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,cutpnt,icompq,ldq,n,qsiz,&
tlvls
integer(${ik}$), intent(out) :: info,indxq(*),iwork(*)
real(sp), intent(inout) :: rho,d(*),givnum(2,*),q(ldq,*),qstore(*)
integer(${ik}$), intent(inout) :: givcol(2,*),givptr(*),perm(*),prmptr(*),qptr(*)
real(sp), intent(out) :: work(*)
end subroutine slaed7
#else
module procedure stdlib${ii}$_slaed7
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, &
indxq, qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,cutpnt,ldq,n,qsiz,tlvls
integer(${ik}$), intent(out) :: info,indxq(*),iwork(*)
real(dp), intent(inout) :: rho,d(*),givnum(2,*),qstore(*)
integer(${ik}$), intent(inout) :: givcol(2,*),givptr(*),perm(*),prmptr(*),qptr(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: q(ldq,*)
complex(dp), intent(out) :: work(*)
end subroutine zlaed7
#else
module procedure stdlib${ii}$_zlaed7
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed7
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed7
#:endif
#:endfor
#:endfor
end interface laed7
interface laed8
!! LAED8 merges the two sets of eigenvalues together into a single
!! sorted set. Then it tries to deflate the size of the problem.
!! There are two ways in which deflation can occur: when two or more
!! eigenvalues are close together or if there is a tiny element in the
!! Z vector. For each such occurrence the order of the related secular
!! equation problem is reduced by one.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, &
indxp, indx, indxq, perm, givptr,givcol, givnum, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,ldq,ldq2,n,qsiz
integer(${ik}$), intent(out) :: givptr,info,k,givcol(2,*),indx(*),indxp(*),perm(&
*)
real(sp), intent(inout) :: rho,d(*),z(*)
integer(${ik}$), intent(inout) :: indxq(*)
real(sp), intent(out) :: dlamda(*),givnum(2,*),w(*)
complex(sp), intent(inout) :: q(ldq,*)
complex(sp), intent(out) :: q2(ldq2,*)
end subroutine claed8
#else
module procedure stdlib${ii}$_claed8
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, &
dlamda, q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,icompq,ldq,ldq2,n,qsiz
integer(${ik}$), intent(out) :: givptr,info,k,givcol(2,*),indx(*),indxp(*),perm(&
*)
real(dp), intent(inout) :: rho,d(*),q(ldq,*),z(*)
integer(${ik}$), intent(inout) :: indxq(*)
real(dp), intent(out) :: dlamda(*),givnum(2,*),q2(ldq2,*),w(*)
end subroutine dlaed8
#else
module procedure stdlib${ii}$_dlaed8
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, &
dlamda, q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,icompq,ldq,ldq2,n,qsiz
integer(${ik}$), intent(out) :: givptr,info,k,givcol(2,*),indx(*),indxp(*),perm(&
*)
real(sp), intent(inout) :: rho,d(*),q(ldq,*),z(*)
integer(${ik}$), intent(inout) :: indxq(*)
real(sp), intent(out) :: dlamda(*),givnum(2,*),q2(ldq2,*),w(*)
end subroutine slaed8
#else
module procedure stdlib${ii}$_slaed8
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, &
indxp, indx, indxq, perm, givptr,givcol, givnum, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: cutpnt,ldq,ldq2,n,qsiz
integer(${ik}$), intent(out) :: givptr,info,k,givcol(2,*),indx(*),indxp(*),perm(&
*)
real(dp), intent(inout) :: rho,d(*),z(*)
integer(${ik}$), intent(inout) :: indxq(*)
real(dp), intent(out) :: dlamda(*),givnum(2,*),w(*)
complex(dp), intent(inout) :: q(ldq,*)
complex(dp), intent(out) :: q2(ldq2,*)
end subroutine zlaed8
#else
module procedure stdlib${ii}$_zlaed8
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed8
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed8
#:endif
#:endfor
#:endfor
end interface laed8
interface laed9
!! LAED9 finds the roots of the secular equation, as defined by the
!! values in D, Z, and RHO, between KSTART and KSTOP. It makes the
!! appropriate calls to DLAED4 and then stores the new matrix of
!! eigenvectors for use in calculating the next level of Z vectors.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,kstart,kstop,ldq,lds,n
real(dp), intent(in) :: rho
real(dp), intent(out) :: d(*),q(ldq,*),s(lds,*)
real(dp), intent(inout) :: dlamda(*),w(*)
end subroutine dlaed9
#else
module procedure stdlib${ii}$_dlaed9
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: k,kstart,kstop,ldq,lds,n
real(sp), intent(in) :: rho
real(sp), intent(out) :: d(*),q(ldq,*),s(lds,*)
real(sp), intent(inout) :: dlamda(*),w(*)
end subroutine slaed9
#else
module procedure stdlib${ii}$_slaed9
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laed9
#:endif
#:endfor
#:endfor
end interface laed9
interface laeda
!! LAEDA computes the Z vector corresponding to the merge step in the
!! CURLVLth step of the merge process with TLVLS steps for the CURPBMth
!! problem.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, &
givnum, q, qptr, z, ztemp, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,n,tlvls,givcol(2,*),givptr(*),perm(&
*),prmptr(*),qptr(*)
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: givnum(2,*),q(*)
real(dp), intent(out) :: z(*),ztemp(*)
end subroutine dlaeda
#else
module procedure stdlib${ii}$_dlaeda
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, &
givnum, q, qptr, z, ztemp, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: curlvl,curpbm,n,tlvls,givcol(2,*),givptr(*),perm(&
*),prmptr(*),qptr(*)
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: givnum(2,*),q(*)
real(sp), intent(out) :: z(*),ztemp(*)
end subroutine slaeda
#else
module procedure stdlib${ii}$_slaeda
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laeda
#:endif
#:endfor
#:endfor
end interface laeda
interface laein
!! LAEIN uses inverse iteration to find a right or left eigenvector
!! corresponding to the eigenvalue W of a complex upper Hessenberg
!! matrix H.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, &
smlnum, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: noinit,rightv
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldh,n
real(sp), intent(in) :: eps3,smlnum
complex(sp), intent(in) :: w,h(ldh,*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(out) :: b(ldb,*)
complex(sp), intent(inout) :: v(*)
end subroutine claein
#else
module procedure stdlib${ii}$_claein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, &
eps3, smlnum, bignum, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: noinit,rightv
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldh,n
real(dp), intent(in) :: bignum,eps3,smlnum,wi,wr,h(ldh,*)
real(dp), intent(out) :: b(ldb,*),work(*)
real(dp), intent(inout) :: vi(*),vr(*)
end subroutine dlaein
#else
module procedure stdlib${ii}$_dlaein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, &
eps3, smlnum, bignum, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: noinit,rightv
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldh,n
real(sp), intent(in) :: bignum,eps3,smlnum,wi,wr,h(ldh,*)
real(sp), intent(out) :: b(ldb,*),work(*)
real(sp), intent(inout) :: vi(*),vr(*)
end subroutine slaein
#else
module procedure stdlib${ii}$_slaein
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, &
smlnum, info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: noinit,rightv
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldb,ldh,n
real(dp), intent(in) :: eps3,smlnum
complex(dp), intent(in) :: w,h(ldh,*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(out) :: b(ldb,*)
complex(dp), intent(inout) :: v(*)
end subroutine zlaein
#else
module procedure stdlib${ii}$_zlaein
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laein
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laein
#:endif
#:endfor
#:endfor
end interface laein
interface laesy
!! LAESY computes the eigendecomposition of a 2-by-2 symmetric matrix
!! ( ( A, B );( B, C ) )
!! provided the norm of the matrix of eigenvectors is larger than
!! some threshold value.
!! RT1 is the eigenvalue of larger absolute value, and RT2 of
!! smaller absolute value. If the eigenvectors are computed, then
!! on return ( CS1, SN1 ) is the unit eigenvector for RT1, hence
!! [ CS1 SN1 ] . [ A B ] . [ CS1 -SN1 ] = [ RT1 0 ]
!! [ -SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 )
import sp,dp,qp,${ik}$,lk
implicit none
complex(sp), intent(in) :: a,b,c
complex(sp), intent(out) :: cs1,evscal,rt1,rt2,sn1
end subroutine claesy
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_claesy
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 )
import sp,dp,qp,${ik}$,lk
implicit none
complex(dp), intent(in) :: a,b,c
complex(dp), intent(out) :: cs1,evscal,rt1,rt2,sn1
end subroutine zlaesy
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_zlaesy
#:endif
#endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$laesy
#:endif
#:endfor
end interface laesy
interface laexc
!! LAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
!! an upper quasi-triangular matrix T by an orthogonal similarity
!! transformation.
!! T must be in Schur canonical form, that is, block upper triangular
!! with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
!! has its diagonal elements equal and its off-diagonal elements of
!! opposite sign.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantq
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: j1,ldq,ldt,n,n1,n2
real(dp), intent(inout) :: q(ldq,*),t(ldt,*)
real(dp), intent(out) :: work(*)
end subroutine dlaexc
#else
module procedure stdlib${ii}$_dlaexc
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantq
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: j1,ldq,ldt,n,n1,n2
real(sp), intent(inout) :: q(ldq,*),t(ldt,*)
real(sp), intent(out) :: work(*)
end subroutine slaexc
#else
module procedure stdlib${ii}$_slaexc
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laexc
#:endif
#:endfor
#:endfor
end interface laexc
interface lagtf
!! LAGTF factorizes the matrix (T - lambda*I), where T is an n by n
!! tridiagonal matrix and lambda is a scalar, as
!! T - lambda*I = PLU,
!! where P is a permutation matrix, L is a unit lower tridiagonal matrix
!! with at most one non-zero sub-diagonal elements per column and U is
!! an upper triangular matrix with at most two non-zero super-diagonal
!! elements per column.
!! The factorization is obtained by Gaussian elimination with partial
!! pivoting and implicit row scaling.
!! The parameter LAMBDA is included in the routine so that LAGTF may
!! be used, in conjunction with DLAGTS, to obtain eigenvectors of T by
!! inverse iteration.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlagtf( n, a, lambda, b, c, tol, d, in, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,in(*)
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: lambda,tol
real(dp), intent(inout) :: a(*),b(*),c(*)
real(dp), intent(out) :: d(*)
end subroutine dlagtf
#else
module procedure stdlib${ii}$_dlagtf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slagtf( n, a, lambda, b, c, tol, d, in, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,in(*)
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: lambda,tol
real(sp), intent(inout) :: a(*),b(*),c(*)
real(sp), intent(out) :: d(*)
end subroutine slagtf
#else
module procedure stdlib${ii}$_slagtf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lagtf
#:endif
#:endfor
#:endfor
end interface lagtf
interface lagtm
!! LAGTM performs a matrix-vector product of the form
!! B := alpha * A * X + beta * B
!! where A is a tridiagonal matrix of order N, B and X are N by NRHS
!! matrices, and alpha and beta are real scalars, each of which may be
!! 0., 1., or -1.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs
real(sp), intent(in) :: alpha,beta
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(in) :: d(*),dl(*),du(*),x(ldx,*)
end subroutine clagtm
#else
module procedure stdlib${ii}$_clagtm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs
real(dp), intent(in) :: alpha,beta,d(*),dl(*),du(*),x(ldx,*)
real(dp), intent(inout) :: b(ldb,*)
end subroutine dlagtm
#else
module procedure stdlib${ii}$_dlagtm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs
real(sp), intent(in) :: alpha,beta,d(*),dl(*),du(*),x(ldx,*)
real(sp), intent(inout) :: b(ldb,*)
end subroutine slagtm
#else
module procedure stdlib${ii}$_slagtm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: trans
integer(${ik}$), intent(in) :: ldb,ldx,n,nrhs
real(dp), intent(in) :: alpha,beta
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(in) :: d(*),dl(*),du(*),x(ldx,*)
end subroutine zlagtm
#else
module procedure stdlib${ii}$_zlagtm
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lagtm
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lagtm
#:endif
#:endfor
#:endfor
end interface lagtm
interface lagts
!! LAGTS may be used to solve one of the systems of equations
!! (T - lambda*I)*x = y or (T - lambda*I)**T*x = y,
!! where T is an n by n tridiagonal matrix, for x, following the
!! factorization of (T - lambda*I) as
!! (T - lambda*I) = P*L*U ,
!! by routine DLAGTF. The choice of equation to be solved is
!! controlled by the argument JOB, and in each case there is an option
!! to perturb zero or very small diagonal elements of U, this option
!! being intended for use in applications such as inverse iteration.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlagts( job, n, a, b, c, d, in, y, tol, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: job,n,in(*)
real(dp), intent(inout) :: tol,y(*)
real(dp), intent(in) :: a(*),b(*),c(*),d(*)
end subroutine dlagts
#else
module procedure stdlib${ii}$_dlagts
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slagts( job, n, a, b, c, d, in, y, tol, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: job,n,in(*)
real(sp), intent(inout) :: tol,y(*)
real(sp), intent(in) :: a(*),b(*),c(*),d(*)
end subroutine slagts
#else
module procedure stdlib${ii}$_slagts
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lagts
#:endif
#:endfor
#:endfor
end interface lagts
interface lahef
!! LAHEF computes a partial factorization of a complex Hermitian
!! matrix A using the Bunch-Kaufman diagonal pivoting method. The
!! partial factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**H U22**H )
!! A = ( L11 0 ) ( D 0 ) ( L11**H L21**H ) if UPLO = 'L'
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! Note that U**H denotes the conjugate transpose of U.
!! LAHEF is an auxiliary routine called by CHETRF. It uses blocked code
!! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
!! A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: w(ldw,*)
end subroutine clahef
#else
module procedure stdlib${ii}$_clahef
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: w(ldw,*)
end subroutine zlahef
#else
module procedure stdlib${ii}$_zlahef
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahef
#:endif
#:endfor
#:endfor
end interface lahef
interface lahef_aa
!! LAHEF_AA factorizes a panel of a complex hermitian matrix A using
!! the Aasen's algorithm. The panel consists of a set of NB rows of A
!! when UPLO is U, or a set of NB columns when UPLO is L.
!! In order to factorize the panel, the Aasen's algorithm requires the
!! last row, or column, of the previous panel. The first row, or column,
!! of A is set to be the first row, or column, of an identity matrix,
!! which is used to factorize the first panel.
!! The resulting J-th row of U, or J-th column of L, is stored in the
!! (J-1)-th row, or column, of A (without the unit diagonals), while
!! the diagonal and subdiagonal of A are overwritten by those of T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
complex(sp), intent(inout) :: a(lda,*),h(ldh,*)
complex(sp), intent(out) :: work(*)
end subroutine clahef_aa
#else
module procedure stdlib${ii}$_clahef_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
complex(dp), intent(inout) :: a(lda,*),h(ldh,*)
complex(dp), intent(out) :: work(*)
end subroutine zlahef_aa
#else
module procedure stdlib${ii}$_zlahef_aa
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahef_aa
#:endif
#:endfor
#:endfor
end interface lahef_aa
interface lahef_rk
!! LAHEF_RK computes a partial factorization of a complex Hermitian
!! matrix A using the bounded Bunch-Kaufman (rook) diagonal
!! pivoting method. The partial factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**H U22**H )
!! A = ( L11 0 ) ( D 0 ) ( L11**H L21**H ) if UPLO = 'L',
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! LAHEF_RK is an auxiliary routine called by CHETRF_RK. It uses
!! blocked code (calling Level 3 BLAS) to update the submatrix
!! A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: w(ldw,*),e(*)
end subroutine clahef_rk
#else
module procedure stdlib${ii}$_clahef_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: w(ldw,*),e(*)
end subroutine zlahef_rk
#else
module procedure stdlib${ii}$_zlahef_rk
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahef_rk
#:endif
#:endfor
#:endfor
end interface lahef_rk
interface lahef_rook
!! LAHEF_ROOK computes a partial factorization of a complex Hermitian
!! matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting
!! method. The partial factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**H U22**H )
!! A = ( L11 0 ) ( D 0 ) ( L11**H L21**H ) if UPLO = 'L'
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! Note that U**H denotes the conjugate transpose of U.
!! LAHEF_ROOK is an auxiliary routine called by CHETRF_ROOK. It uses
!! blocked code (calling Level 3 BLAS) to update the submatrix
!! A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: w(ldw,*)
end subroutine clahef_rook
#else
module procedure stdlib${ii}$_clahef_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: w(ldw,*)
end subroutine zlahef_rook
#else
module procedure stdlib${ii}$_zlahef_rook
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahef_rook
#:endif
#:endfor
#:endfor
end interface lahef_rook
interface lahqr
!! LAHQR is an auxiliary routine called by CHSEQR to update the
!! eigenvalues and Schur decomposition already computed by CHSEQR, by
!! dealing with the Hessenberg submatrix in rows and columns ILO to
!! IHI.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(sp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(sp), intent(out) :: w(*)
end subroutine clahqr
#else
module procedure stdlib${ii}$_clahqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, &
ldz, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(dp), intent(inout) :: h(ldh,*),z(ldz,*)
real(dp), intent(out) :: wi(*),wr(*)
end subroutine dlahqr
#else
module procedure stdlib${ii}$_dlahqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, &
ldz, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(sp), intent(inout) :: h(ldh,*),z(ldz,*)
real(sp), intent(out) :: wi(*),wr(*)
end subroutine slahqr
#else
module procedure stdlib${ii}$_slahqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(dp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(dp), intent(out) :: w(*)
end subroutine zlahqr
#else
module procedure stdlib${ii}$_zlahqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lahqr
#:endif
#:endfor
#:endfor
end interface lahqr
interface laic1
!! LAIC1 applies one step of incremental condition estimation in
!! its simplest version:
!! Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
!! lower triangular matrix L, such that
!! twonorm(L*x) = sest
!! Then LAIC1 computes sestpr, s, c such that
!! the vector
!! [ s*x ]
!! xhat = [ c ]
!! is an approximate singular vector of
!! [ L 0 ]
!! Lhat = [ w**H gamma ]
!! in the sense that
!! twonorm(Lhat*xhat) = sestpr.
!! Depending on JOB, an estimate for the largest or smallest singular
!! value is computed.
!! Note that [s c]**H and sestpr**2 is an eigenpair of the system
!! diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ]
!! [ conjg(gamma) ]
!! where alpha = x**H*w.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claic1( job, j, x, sest, w, gamma, sestpr, s, c )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: j,job
real(sp), intent(in) :: sest
real(sp), intent(out) :: sestpr
complex(sp), intent(out) :: c,s
complex(sp), intent(in) :: gamma,w(j),x(j)
end subroutine claic1
#else
module procedure stdlib${ii}$_claic1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaic1( job, j, x, sest, w, gamma, sestpr, s, c )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: j,job
real(dp), intent(out) :: c,s,sestpr
real(dp), intent(in) :: gamma,sest,w(j),x(j)
end subroutine dlaic1
#else
module procedure stdlib${ii}$_dlaic1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaic1( job, j, x, sest, w, gamma, sestpr, s, c )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: j,job
real(sp), intent(out) :: c,s,sestpr
real(sp), intent(in) :: gamma,sest,w(j),x(j)
end subroutine slaic1
#else
module procedure stdlib${ii}$_slaic1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaic1( job, j, x, sest, w, gamma, sestpr, s, c )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: j,job
real(dp), intent(in) :: sest
real(dp), intent(out) :: sestpr
complex(dp), intent(out) :: c,s
complex(dp), intent(in) :: gamma,w(j),x(j)
end subroutine zlaic1
#else
module procedure stdlib${ii}$_zlaic1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laic1
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laic1
#:endif
#:endfor
#:endfor
end interface laic1
interface laisnan
!! This routine is not for general use. It exists solely to avoid
!! over-optimization in DISNAN.
!! LAISNAN checks for NaNs by comparing its two arguments for
!! inequality. NaN is the only floating-point value where NaN != NaN
!! returns .TRUE. To check for NaNs, pass the same variable as both
!! arguments.
!! A compiler must assume that the two arguments are
!! not the same variable, and the test will not be optimized away.
!! Interprocedural or whole-program optimization may delete this
!! test. The ISNAN functions will be replaced by the correct
!! Fortran 03 intrinsic once the intrinsic is widely available.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure logical(lk) function dlaisnan( din1, din2 )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: din1,din2
end function dlaisnan
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_dlaisnan
#:endif
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure logical(lk) function slaisnan( sin1, sin2 )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: sin1,sin2
end function slaisnan
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_slaisnan
#:endif
#endif
#:endfor
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib_${ri}$laisnan
#:endif
#:endfor
end interface laisnan
interface lals0
!! LALS0 applies back the multiplying factors of either the left or the
!! right singular vector matrix of a diagonal matrix appended by a row
!! to the right hand side matrix B in solving the least squares problem
!! using the divide-and-conquer SVD approach.
!! For the left singular vector matrix, three types of orthogonal
!! matrices are involved:
!! (1L) Givens rotations: the number of such rotations is GIVPTR; the
!! pairs of columns/rows they were applied to are stored in GIVCOL;
!! and the C- and S-values of these rotations are stored in GIVNUM.
!! (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
!! row, and for J=2:N, PERM(J)-th row of B is to be moved to the
!! J-th row.
!! (3L) The left singular vector matrix of the remaining matrix.
!! For the right singular vector matrix, four types of orthogonal
!! matrices are involved:
!! (1R) The right singular vector matrix of the remaining matrix.
!! (2R) If SQRE = 1, one extra Givens rotation to generate the right
!! null space.
!! (3R) The inverse transformation of (2L).
!! (4R) The inverse transformation of (1L).
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, &
givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: givptr,icompq,k,ldb,ldbx,ldgcol,ldgnum,nl,nr,nrhs,&
sqre,givcol(ldgcol,*),perm(*)
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: c,s,difl(*),difr(ldgnum,*),givnum(ldgnum,*),poles(&
ldgnum,*),z(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(out) :: bx(ldbx,*)
end subroutine clals0
#else
module procedure stdlib${ii}$_clals0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, &
givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: givptr,icompq,k,ldb,ldbx,ldgcol,ldgnum,nl,nr,nrhs,&
sqre,givcol(ldgcol,*),perm(*)
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: c,s,difl(*),difr(ldgnum,*),givnum(ldgnum,*),poles(&
ldgnum,*),z(*)
real(dp), intent(inout) :: b(ldb,*)
real(dp), intent(out) :: bx(ldbx,*),work(*)
end subroutine dlals0
#else
module procedure stdlib${ii}$_dlals0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, &
givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: givptr,icompq,k,ldb,ldbx,ldgcol,ldgnum,nl,nr,nrhs,&
sqre,givcol(ldgcol,*),perm(*)
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: c,s,difl(*),difr(ldgnum,*),givnum(ldgnum,*),poles(&
ldgnum,*),z(*)
real(sp), intent(inout) :: b(ldb,*)
real(sp), intent(out) :: bx(ldbx,*),work(*)
end subroutine slals0
#else
module procedure stdlib${ii}$_slals0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, &
givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: givptr,icompq,k,ldb,ldbx,ldgcol,ldgnum,nl,nr,nrhs,&
sqre,givcol(ldgcol,*),perm(*)
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: c,s,difl(*),difr(ldgnum,*),givnum(ldgnum,*),poles(&
ldgnum,*),z(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(out) :: bx(ldbx,*)
end subroutine zlals0
#else
module procedure stdlib${ii}$_zlals0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lals0
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lals0
#:endif
#:endfor
#:endfor
end interface lals0
interface lalsa
!! LALSA is an itermediate step in solving the least squares problem
!! by computing the SVD of the coefficient matrix in compact form (The
!! singular vectors are computed as products of simple orthorgonal
!! matrices.).
!! If ICOMPQ = 0, LALSA applies the inverse of the left singular vector
!! matrix of an upper bidiagonal matrix to the right hand side; and if
!! ICOMPQ = 1, LALSA applies the right singular vector matrix to the
!! right hand side. The singular vector matrices were generated in
!! compact form by LALSA.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, &
difl, difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, rwork,iwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldb,ldbx,ldgcol,ldu,n,nrhs,smlsiz,givcol(&
ldgcol,*),givptr(*),k(*),perm(ldgcol,*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),z(ldu,*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(out) :: bx(ldbx,*)
end subroutine clalsa
#else
module procedure stdlib${ii}$_clalsa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, &
difl, difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, work,iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldb,ldbx,ldgcol,ldu,n,nrhs,smlsiz,givcol(&
ldgcol,*),givptr(*),k(*),perm(ldgcol,*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(inout) :: b(ldb,*)
real(dp), intent(out) :: bx(ldbx,*),work(*)
real(dp), intent(in) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),z(ldu,*)
end subroutine dlalsa
#else
module procedure stdlib${ii}$_dlalsa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, &
difl, difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, work,iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldb,ldbx,ldgcol,ldu,n,nrhs,smlsiz,givcol(&
ldgcol,*),givptr(*),k(*),perm(ldgcol,*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(inout) :: b(ldb,*)
real(sp), intent(out) :: bx(ldbx,*),work(*)
real(sp), intent(in) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),z(ldu,*)
end subroutine slalsa
#else
module procedure stdlib${ii}$_slalsa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, &
difl, difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, rwork,iwork, info &
)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldb,ldbx,ldgcol,ldu,n,nrhs,smlsiz,givcol(&
ldgcol,*),givptr(*),k(*),perm(ldgcol,*)
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),z(ldu,*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(out) :: bx(ldbx,*)
end subroutine zlalsa
#else
module procedure stdlib${ii}$_zlalsa
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lalsa
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lalsa
#:endif
#:endfor
#:endfor
end interface lalsa
interface lalsd
!! LALSD uses the singular value decomposition of A to solve the least
!! squares problem of finding X to minimize the Euclidean norm of each
!! column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
!! are N-by-NRHS. The solution X overwrites B.
!! The singular values of A smaller than RCOND times the largest
!! singular value are treated as zero in solving the least squares
!! problem; in this case a minimum norm solution is returned.
!! The actual singular values are returned in D in ascending order.
!! This code makes very mild assumptions about floating point
!! arithmetic. It will work on machines with a guard digit in
!! add/subtract, or on those binary machines without guard digits
!! which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
!! It could conceivably fail on hexadecimal or decimal machines
!! without guard digits, but we know of none.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, &
rwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs,smlsiz
real(sp), intent(in) :: rcond
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(inout) :: b(ldb,*)
complex(sp), intent(out) :: work(*)
end subroutine clalsd
#else
module procedure stdlib${ii}$_clalsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs,smlsiz
real(dp), intent(in) :: rcond
real(dp), intent(inout) :: b(ldb,*),d(*),e(*)
real(dp), intent(out) :: work(*)
end subroutine dlalsd
#else
module procedure stdlib${ii}$_dlalsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, &
iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs,smlsiz
real(sp), intent(in) :: rcond
real(sp), intent(inout) :: b(ldb,*),d(*),e(*)
real(sp), intent(out) :: work(*)
end subroutine slalsd
#else
module procedure stdlib${ii}$_slalsd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, &
rwork, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,rank,iwork(*)
integer(${ik}$), intent(in) :: ldb,n,nrhs,smlsiz
real(dp), intent(in) :: rcond
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(inout) :: b(ldb,*)
complex(dp), intent(out) :: work(*)
end subroutine zlalsd
#else
module procedure stdlib${ii}$_zlalsd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lalsd
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lalsd
#:endif
#:endfor
#:endfor
end interface lalsd
interface lamrg
!! LAMRG will create a permutation list which will merge the elements
!! of A (which is composed of two independently sorted sets) into a
!! single set which is sorted in ascending order.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlamrg( n1, n2, a, dtrd1, dtrd2, index )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: dtrd1,dtrd2,n1,n2
integer(${ik}$), intent(out) :: index(*)
real(dp), intent(in) :: a(*)
end subroutine dlamrg
#else
module procedure stdlib${ii}$_dlamrg
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slamrg( n1, n2, a, strd1, strd2, index )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n1,n2,strd1,strd2
integer(${ik}$), intent(out) :: index(*)
real(sp), intent(in) :: a(*)
end subroutine slamrg
#else
module procedure stdlib${ii}$_slamrg
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lamrg
#:endif
#:endfor
#:endfor
end interface lamrg
interface lamswlq
!! LAMSWLQ overwrites the general complex M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q * C C * Q
!! TRANS = 'T': Q**H * C C * Q**H
!! where Q is a complex unitary matrix defined as the product of blocked
!! elementary reflectors computed by short wide LQ
!! factorization (CLASWLQ)
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
complex(sp), intent(in) :: a(lda,*),t(ldt,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: c(ldc,*)
end subroutine clamswlq
#else
module procedure stdlib${ii}$_clamswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
real(dp), intent(in) :: a(lda,*),t(ldt,*)
real(dp), intent(out) :: work(*)
real(dp), intent(inout) :: c(ldc,*)
end subroutine dlamswlq
#else
module procedure stdlib${ii}$_dlamswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
real(sp), intent(in) :: a(lda,*),t(ldt,*)
real(sp), intent(out) :: work(*)
real(sp), intent(inout) :: c(ldc,*)
end subroutine slamswlq
#else
module procedure stdlib${ii}$_slamswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
complex(dp), intent(in) :: a(lda,*),t(ldt,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zlamswlq
#else
module procedure stdlib${ii}$_zlamswlq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lamswlq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lamswlq
#:endif
#:endfor
#:endfor
end interface lamswlq
interface lamtsqr
!! LAMTSQR overwrites the general complex M-by-N matrix C with
!! SIDE = 'L' SIDE = 'R'
!! TRANS = 'N': Q * C C * Q
!! TRANS = 'C': Q**H * C C * Q**H
!! where Q is a complex unitary matrix defined as the product
!! of blocked elementary reflectors computed by tall skinny
!! QR factorization (CLATSQR)
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
complex(sp), intent(in) :: a(lda,*),t(ldt,*)
complex(sp), intent(out) :: work(*)
complex(sp), intent(inout) :: c(ldc,*)
end subroutine clamtsqr
#else
module procedure stdlib${ii}$_clamtsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
real(dp), intent(in) :: a(lda,*),t(ldt,*)
real(dp), intent(out) :: work(*)
real(dp), intent(inout) :: c(ldc,*)
end subroutine dlamtsqr
#else
module procedure stdlib${ii}$_dlamtsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
real(sp), intent(in) :: a(lda,*),t(ldt,*)
real(sp), intent(out) :: work(*)
real(sp), intent(inout) :: c(ldc,*)
end subroutine slamtsqr
#else
module procedure stdlib${ii}$_slamtsqr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side,trans
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,k,mb,nb,ldt,lwork,ldc
complex(dp), intent(in) :: a(lda,*),t(ldt,*)
complex(dp), intent(out) :: work(*)
complex(dp), intent(inout) :: c(ldc,*)
end subroutine zlamtsqr
#else
module procedure stdlib${ii}$_zlamtsqr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lamtsqr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lamtsqr
#:endif
#:endfor
#:endfor
end interface lamtsqr
interface laneg
!! LANEG computes the Sturm count, the number of negative pivots
!! encountered while factoring tridiagonal T - sigma I = L D L^T.
!! This implementation works directly on the factors without forming
!! the tridiagonal matrix T. The Sturm count is also the number of
!! eigenvalues of T less than sigma.
!! This routine is called from DLARRB.
!! The current routine does not use the PIVMIN parameter but rather
!! requires IEEE-754 propagation of Infinities and NaNs. This
!! routine also has no input range restrictions but does require
!! default exception handling such that x/0 produces Inf when x is
!! non-zero, and Inf/Inf produces NaN. For more information, see:
!! Marques, Riedy, and Voemel, "Benefits of IEEE-754 Features in
!! Modern Symmetric Tridiagonal Eigensolvers," SIAM Journal on
!! Scientific Computing, v28, n5, 2006. DOI 10.1137/050641624
!! (Tech report version in LAWN 172 with the same title.)
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure integer(${ik}$) function dlaneg( n, d, lld, sigma, pivmin, r )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,r
real(dp), intent(in) :: pivmin,sigma,d(*),lld(*)
end function dlaneg
#else
module procedure stdlib${ii}$_dlaneg
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure integer(${ik}$) function slaneg( n, d, lld, sigma, pivmin, r )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n,r
real(sp), intent(in) :: pivmin,sigma,d(*),lld(*)
end function slaneg
#else
module procedure stdlib${ii}$_slaneg
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laneg
#:endif
#:endfor
#:endfor
end interface laneg
interface langb
!! LANGB returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of an
!! n by n band matrix A, with kl sub-diagonals and ku super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clangb( norm, n, kl, ku, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: kl,ku,ldab,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ab(ldab,*)
end function clangb
#else
module procedure stdlib${ii}$_clangb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlangb( norm, n, kl, ku, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: kl,ku,ldab,n
real(dp), intent(in) :: ab(ldab,*)
real(dp), intent(out) :: work(*)
end function dlangb
#else
module procedure stdlib${ii}$_dlangb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slangb( norm, n, kl, ku, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: kl,ku,ldab,n
real(sp), intent(in) :: ab(ldab,*)
real(sp), intent(out) :: work(*)
end function slangb
#else
module procedure stdlib${ii}$_slangb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlangb( norm, n, kl, ku, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: kl,ku,ldab,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ab(ldab,*)
end function zlangb
#else
module procedure stdlib${ii}$_zlangb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$langb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$langb
#:endif
#:endfor
#:endfor
end interface langb
interface lange
!! LANGE returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clange( norm, m, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: a(lda,*)
end function clange
#else
module procedure stdlib${ii}$_clange
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlange( norm, m, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: work(*)
end function dlange
#else
module procedure stdlib${ii}$_dlange
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slange( norm, m, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: work(*)
end function slange
#else
module procedure stdlib${ii}$_slange
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlange( norm, m, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: a(lda,*)
end function zlange
#else
module procedure stdlib${ii}$_zlange
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lange
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lange
#:endif
#:endfor
#:endfor
end interface lange
interface langt
!! LANGT returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex tridiagonal matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function clangt( norm, n, dl, d, du )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
complex(sp), intent(in) :: d(*),dl(*),du(*)
end function clangt
#else
module procedure stdlib${ii}$_clangt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function dlangt( norm, n, dl, d, du )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: d(*),dl(*),du(*)
end function dlangt
#else
module procedure stdlib${ii}$_dlangt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function slangt( norm, n, dl, d, du )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: d(*),dl(*),du(*)
end function slangt
#else
module procedure stdlib${ii}$_slangt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function zlangt( norm, n, dl, d, du )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
complex(dp), intent(in) :: d(*),dl(*),du(*)
end function zlangt
#else
module procedure stdlib${ii}$_zlangt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$langt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$langt
#:endif
#:endfor
#:endfor
end interface langt
interface lanhb
!! LANHB returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of an
!! n by n hermitian band matrix A, with k super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clanhb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ab(ldab,*)
end function clanhb
#else
module procedure stdlib${ii}$_clanhb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlanhb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ab(ldab,*)
end function zlanhb
#else
module procedure stdlib${ii}$_zlanhb
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhb
#:endif
#:endfor
#:endfor
end interface lanhb
interface lanhe
!! LANHE returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex hermitian matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clanhe( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: a(lda,*)
end function clanhe
#else
module procedure stdlib${ii}$_clanhe
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlanhe( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: a(lda,*)
end function zlanhe
#else
module procedure stdlib${ii}$_zlanhe
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhe
#:endif
#:endfor
#:endfor
end interface lanhe
interface lanhf
!! LANHF returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex Hermitian matrix A in RFP format.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clanhf( norm, transr, uplo, n, a, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,transr,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: work(0:*)
complex(sp), intent(in) :: a(0:*)
end function clanhf
#else
module procedure stdlib${ii}$_clanhf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlanhf( norm, transr, uplo, n, a, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,transr,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: work(0:*)
complex(dp), intent(in) :: a(0:*)
end function zlanhf
#else
module procedure stdlib${ii}$_zlanhf
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhf
#:endif
#:endfor
#:endfor
end interface lanhf
interface lanhp
!! LANHP returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex hermitian matrix A, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clanhp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ap(*)
end function clanhp
#else
module procedure stdlib${ii}$_clanhp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlanhp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ap(*)
end function zlanhp
#else
module procedure stdlib${ii}$_zlanhp
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhp
#:endif
#:endfor
#:endfor
end interface lanhp
interface lanhs
!! LANHS returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! Hessenberg matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clanhs( norm, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: a(lda,*)
end function clanhs
#else
module procedure stdlib${ii}$_clanhs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlanhs( norm, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: work(*)
end function dlanhs
#else
module procedure stdlib${ii}$_dlanhs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slanhs( norm, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: work(*)
end function slanhs
#else
module procedure stdlib${ii}$_slanhs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlanhs( norm, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: a(lda,*)
end function zlanhs
#else
module procedure stdlib${ii}$_zlanhs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanhs
#:endif
#:endfor
#:endfor
end interface lanhs
interface lanht
!! LANHT returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex Hermitian tridiagonal matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function clanht( norm, n, d, e )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: d(*)
complex(sp), intent(in) :: e(*)
end function clanht
#else
module procedure stdlib${ii}$_clanht
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function zlanht( norm, n, d, e )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: d(*)
complex(dp), intent(in) :: e(*)
end function zlanht
#else
module procedure stdlib${ii}$_zlanht
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanht
#:endif
#:endfor
#:endfor
end interface lanht
interface lansb
!! LANSB returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of an
!! n by n symmetric band matrix A, with k super-diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clansb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ab(ldab,*)
end function clansb
#else
module procedure stdlib${ii}$_clansb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlansb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(dp), intent(in) :: ab(ldab,*)
real(dp), intent(out) :: work(*)
end function dlansb
#else
module procedure stdlib${ii}$_dlansb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slansb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(sp), intent(in) :: ab(ldab,*)
real(sp), intent(out) :: work(*)
end function slansb
#else
module procedure stdlib${ii}$_slansb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlansb( norm, uplo, n, k, ab, ldab,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ab(ldab,*)
end function zlansb
#else
module procedure stdlib${ii}$_zlansb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansb
#:endif
#:endfor
#:endfor
end interface lansb
interface lansf
!! LANSF returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! real symmetric matrix A in RFP format.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlansf( norm, transr, uplo, n, a, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,transr,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: a(0:*)
real(dp), intent(out) :: work(0:*)
end function dlansf
#else
module procedure stdlib${ii}$_dlansf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slansf( norm, transr, uplo, n, a, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,transr,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: a(0:*)
real(sp), intent(out) :: work(0:*)
end function slansf
#else
module procedure stdlib${ii}$_slansf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansf
#:endif
#:endfor
#:endfor
end interface lansf
interface lansp
!! LANSP returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex symmetric matrix A, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clansp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ap(*)
end function clansp
#else
module procedure stdlib${ii}$_clansp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlansp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: ap(*)
real(dp), intent(out) :: work(*)
end function dlansp
#else
module procedure stdlib${ii}$_dlansp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slansp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: ap(*)
real(sp), intent(out) :: work(*)
end function slansp
#else
module procedure stdlib${ii}$_slansp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlansp( norm, uplo, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ap(*)
end function zlansp
#else
module procedure stdlib${ii}$_zlansp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansp
#:endif
#:endfor
#:endfor
end interface lansp
interface lanst
!! LANST returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! real symmetric tridiagonal matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(dp) function dlanst( norm, n, d, e )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: d(*),e(*)
end function dlanst
#else
module procedure stdlib${ii}$_dlanst
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure real(sp) function slanst( norm, n, d, e )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: d(*),e(*)
end function slanst
#else
module procedure stdlib${ii}$_slanst
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lanst
#:endif
#:endfor
#:endfor
end interface lanst
interface lansy
!! LANSY returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! complex symmetric matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clansy( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: a(lda,*)
end function clansy
#else
module procedure stdlib${ii}$_clansy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlansy( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: work(*)
end function dlansy
#else
module procedure stdlib${ii}$_dlansy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slansy( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: work(*)
end function slansy
#else
module procedure stdlib${ii}$_slansy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlansy( norm, uplo, n, a, lda, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: norm,uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: a(lda,*)
end function zlansy
#else
module procedure stdlib${ii}$_zlansy
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansy
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lansy
#:endif
#:endfor
#:endfor
end interface lansy
interface lantb
!! LANTB returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of an
!! n by n triangular band matrix A, with ( k + 1 ) diagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clantb( norm, uplo, diag, n, k, ab,ldab, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ab(ldab,*)
end function clantb
#else
module procedure stdlib${ii}$_clantb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlantb( norm, uplo, diag, n, k, ab,ldab, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(dp), intent(in) :: ab(ldab,*)
real(dp), intent(out) :: work(*)
end function dlantb
#else
module procedure stdlib${ii}$_dlantb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slantb( norm, uplo, diag, n, k, ab,ldab, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(sp), intent(in) :: ab(ldab,*)
real(sp), intent(out) :: work(*)
end function slantb
#else
module procedure stdlib${ii}$_slantb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlantb( norm, uplo, diag, n, k, ab,ldab, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: k,ldab,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ab(ldab,*)
end function zlantb
#else
module procedure stdlib${ii}$_zlantb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantb
#:endif
#:endfor
#:endfor
end interface lantb
interface lantp
!! LANTP returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! triangular matrix A, supplied in packed form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clantp( norm, uplo, diag, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: ap(*)
end function clantp
#else
module procedure stdlib${ii}$_clantp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlantp( norm, uplo, diag, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: ap(*)
real(dp), intent(out) :: work(*)
end function dlantp
#else
module procedure stdlib${ii}$_dlantp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slantp( norm, uplo, diag, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: ap(*)
real(sp), intent(out) :: work(*)
end function slantp
#else
module procedure stdlib${ii}$_slantp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlantp( norm, uplo, diag, n, ap, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: ap(*)
end function zlantp
#else
module procedure stdlib${ii}$_zlantp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantp
#:endif
#:endfor
#:endfor
end interface lantp
interface lantr
!! LANTR returns the value of the one norm, or the Frobenius norm, or
!! the infinity norm, or the element of largest absolute value of a
!! trapezoidal or triangular matrix A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function clantr( norm, uplo, diag, m, n, a, lda,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(out) :: work(*)
complex(sp), intent(in) :: a(lda,*)
end function clantr
#else
module procedure stdlib${ii}$_clantr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function dlantr( norm, uplo, diag, m, n, a, lda,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: work(*)
end function dlantr
#else
module procedure stdlib${ii}$_dlantr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(sp) function slantr( norm, uplo, diag, m, n, a, lda,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: work(*)
end function slantr
#else
module procedure stdlib${ii}$_slantr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
real(dp) function zlantr( norm, uplo, diag, m, n, a, lda,work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,norm,uplo
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(out) :: work(*)
complex(dp), intent(in) :: a(lda,*)
end function zlantr
#else
module procedure stdlib${ii}$_zlantr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lantr
#:endif
#:endfor
#:endfor
end interface lantr
interface laorhr_col_getrfnp
!! LAORHR_COL_GETRFNP computes the modified LU factorization without
!! pivoting of a real general M-by-N matrix A. The factorization has
!! the form:
!! A - S = L * U,
!! where:
!! S is a m-by-n diagonal sign matrix with the diagonal D, so that
!! D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed
!! as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing
!! i-1 steps of Gaussian elimination. This means that the diagonal
!! element at each step of "modified" Gaussian elimination is
!! at least one in absolute value (so that division-by-zero not
!! not possible during the division by the diagonal element);
!! L is a M-by-N lower triangular matrix with unit diagonal elements
!! (lower trapezoidal if M > N);
!! and U is a M-by-N upper triangular matrix
!! (upper trapezoidal if M < N).
!! This routine is an auxiliary routine used in the Householder
!! reconstruction routine DORHR_COL. In DORHR_COL, this routine is
!! applied to an M-by-N matrix A with orthonormal columns, where each
!! element is bounded by one in absolute value. With the choice of
!! the matrix S above, one can show that the diagonal element at each
!! step of Gaussian elimination is the largest (in absolute value) in
!! the column on or below the diagonal, so that no pivoting is required
!! for numerical stability [1].
!! For more details on the Householder reconstruction algorithm,
!! including the modified LU factorization, see [1].
!! This is the blocked right-looking version of the algorithm,
!! calling Level 3 BLAS to update the submatrix. To factorize a block,
!! this routine calls the recursive routine LAORHR_COL_GETRFNP2.
!! [1] "Reconstructing Householder vectors from tall-skinny QR",
!! G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
!! E. Solomonik, J. Parallel Distrib. Comput.,
!! vol. 85, pp. 3-31, 2015.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaorhr_col_getrfnp( m, n, a, lda, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: d(*)
end subroutine dlaorhr_col_getrfnp
#else
module procedure stdlib${ii}$_dlaorhr_col_getrfnp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaorhr_col_getrfnp( m, n, a, lda, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: d(*)
end subroutine slaorhr_col_getrfnp
#else
module procedure stdlib${ii}$_slaorhr_col_getrfnp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laorhr_col_getrfnp
#:endif
#:endfor
#:endfor
end interface laorhr_col_getrfnp
interface laorhr_col_getrfnp2
!! LAORHR_COL_GETRFNP2 computes the modified LU factorization without
!! pivoting of a real general M-by-N matrix A. The factorization has
!! the form:
!! A - S = L * U,
!! where:
!! S is a m-by-n diagonal sign matrix with the diagonal D, so that
!! D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed
!! as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing
!! i-1 steps of Gaussian elimination. This means that the diagonal
!! element at each step of "modified" Gaussian elimination is at
!! least one in absolute value (so that division-by-zero not
!! possible during the division by the diagonal element);
!! L is a M-by-N lower triangular matrix with unit diagonal elements
!! (lower trapezoidal if M > N);
!! and U is a M-by-N upper triangular matrix
!! (upper trapezoidal if M < N).
!! This routine is an auxiliary routine used in the Householder
!! reconstruction routine DORHR_COL. In DORHR_COL, this routine is
!! applied to an M-by-N matrix A with orthonormal columns, where each
!! element is bounded by one in absolute value. With the choice of
!! the matrix S above, one can show that the diagonal element at each
!! step of Gaussian elimination is the largest (in absolute value) in
!! the column on or below the diagonal, so that no pivoting is required
!! for numerical stability [1].
!! For more details on the Householder reconstruction algorithm,
!! including the modified LU factorization, see [1].
!! This is the recursive version of the LU factorization algorithm.
!! Denote A - S by B. The algorithm divides the matrix B into four
!! submatrices:
!! [ B11 | B12 ] where B11 is n1 by n1,
!! B = [ -----|----- ] B21 is (m-n1) by n1,
!! [ B21 | B22 ] B12 is n1 by n2,
!! B22 is (m-n1) by n2,
!! with n1 = min(m,n)/2, n2 = n-n1.
!! The subroutine calls itself to factor B11, solves for B21,
!! solves for B12, updates B22, then calls itself to factor B22.
!! For more details on the recursive LU algorithm, see [2].
!! LAORHR_COL_GETRFNP2 is called to factorize a block by the blocked
!! routine DLAORHR_COL_GETRFNP, which uses blocked code calling
!! Level 3 BLAS to update the submatrix. However, LAORHR_COL_GETRFNP2
!! is self-sufficient and can be used without DLAORHR_COL_GETRFNP.
!! [1] "Reconstructing Householder vectors from tall-skinny QR",
!! G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
!! E. Solomonik, J. Parallel Distrib. Comput.,
!! vol. 85, pp. 3-31, 2015.
!! [2] "Recursion leads to automatic variable blocking for dense linear
!! algebra algorithms", F. Gustavson, IBM J. of Res. and Dev.,
!! vol. 41, no. 6, pp. 737-755, 1997.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine dlaorhr_col_getrfnp2( m, n, a, lda, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: d(*)
end subroutine dlaorhr_col_getrfnp2
#else
module procedure stdlib${ii}$_dlaorhr_col_getrfnp2
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure recursive subroutine slaorhr_col_getrfnp2( m, n, a, lda, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: d(*)
end subroutine slaorhr_col_getrfnp2
#else
module procedure stdlib${ii}$_slaorhr_col_getrfnp2
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laorhr_col_getrfnp2
#:endif
#:endfor
#:endfor
end interface laorhr_col_getrfnp2
interface lapll
!! Given two column vectors X and Y, let
!! A = ( X Y ).
!! The subroutine first computes the QR factorization of A = Q*R,
!! and then computes the SVD of the 2-by-2 upper triangular matrix R.
!! The smaller singular value of R is returned in SSMIN, which is used
!! as the measurement of the linear dependency of the vectors X and Y.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clapll( n, x, incx, y, incy, ssmin )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(out) :: ssmin
complex(sp), intent(inout) :: x(*),y(*)
end subroutine clapll
#else
module procedure stdlib${ii}$_clapll
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlapll( n, x, incx, y, incy, ssmin )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(out) :: ssmin
real(dp), intent(inout) :: x(*),y(*)
end subroutine dlapll
#else
module procedure stdlib${ii}$_dlapll
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slapll( n, x, incx, y, incy, ssmin )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
real(sp), intent(out) :: ssmin
real(sp), intent(inout) :: x(*),y(*)
end subroutine slapll
#else
module procedure stdlib${ii}$_slapll
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlapll( n, x, incx, y, incy, ssmin )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,incy,n
real(dp), intent(out) :: ssmin
complex(dp), intent(inout) :: x(*),y(*)
end subroutine zlapll
#else
module procedure stdlib${ii}$_zlapll
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapll
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapll
#:endif
#:endfor
#:endfor
end interface lapll
interface lapmr
!! LAPMR rearranges the rows of the M by N matrix X as specified
!! by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
!! If FORWRD = .TRUE., forward permutation:
!! X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
!! If FORWRD = .FALSE., backward permutation:
!! X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clapmr( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine clapmr
#else
module procedure stdlib${ii}$_clapmr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlapmr( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
real(dp), intent(inout) :: x(ldx,*)
end subroutine dlapmr
#else
module procedure stdlib${ii}$_dlapmr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slapmr( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
real(sp), intent(inout) :: x(ldx,*)
end subroutine slapmr
#else
module procedure stdlib${ii}$_slapmr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlapmr( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zlapmr
#else
module procedure stdlib${ii}$_zlapmr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapmr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapmr
#:endif
#:endfor
#:endfor
end interface lapmr
interface lapmt
!! LAPMT rearranges the columns of the M by N matrix X as specified
!! by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
!! If FORWRD = .TRUE., forward permutation:
!! X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
!! If FORWRD = .FALSE., backward permutation:
!! X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clapmt( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
complex(sp), intent(inout) :: x(ldx,*)
end subroutine clapmt
#else
module procedure stdlib${ii}$_clapmt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlapmt( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
real(dp), intent(inout) :: x(ldx,*)
end subroutine dlapmt
#else
module procedure stdlib${ii}$_dlapmt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slapmt( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
real(sp), intent(inout) :: x(ldx,*)
end subroutine slapmt
#else
module procedure stdlib${ii}$_slapmt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlapmt( forwrd, m, n, x, ldx, k )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: forwrd
integer(${ik}$), intent(in) :: ldx,m,n
integer(${ik}$), intent(inout) :: k(*)
complex(dp), intent(inout) :: x(ldx,*)
end subroutine zlapmt
#else
module procedure stdlib${ii}$_zlapmt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapmt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lapmt
#:endif
#:endfor
#:endfor
end interface lapmt
interface laqgb
!! LAQGB equilibrates a general M by N band matrix A with KL
!! subdiagonals and KU superdiagonals using the row and scaling factors
!! in the vectors R and C.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(inout) :: ab(ldab,*)
end subroutine claqgb
#else
module procedure stdlib${ii}$_claqgb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(inout) :: ab(ldab,*)
end subroutine dlaqgb
#else
module procedure stdlib${ii}$_dlaqgb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(sp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(inout) :: ab(ldab,*)
end subroutine slaqgb
#else
module procedure stdlib${ii}$_slaqgb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: kl,ku,ldab,m,n
real(dp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(inout) :: ab(ldab,*)
end subroutine zlaqgb
#else
module procedure stdlib${ii}$_zlaqgb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqgb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqgb
#:endif
#:endfor
#:endfor
end interface laqgb
interface laqge
!! LAQGE equilibrates a general M by N matrix A using the row and
!! column scaling factors in the vectors R and C.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine claqge
#else
module procedure stdlib${ii}$_claqge
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
real(dp), intent(inout) :: a(lda,*)
end subroutine dlaqge
#else
module procedure stdlib${ii}$_dlaqge
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
real(sp), intent(inout) :: a(lda,*)
end subroutine slaqge
#else
module procedure stdlib${ii}$_slaqge
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: amax,colcnd,rowcnd,c(*),r(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlaqge
#else
module procedure stdlib${ii}$_zlaqge
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqge
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqge
#:endif
#:endfor
#:endfor
end interface laqge
interface laqhb
!! LAQHB equilibrates an Hermitian band matrix A using the scaling
!! factors in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(sp), intent(in) :: amax,scond
real(sp), intent(out) :: s(*)
complex(sp), intent(inout) :: ab(ldab,*)
end subroutine claqhb
#else
module procedure stdlib${ii}$_claqhb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(dp), intent(in) :: amax,scond
real(dp), intent(out) :: s(*)
complex(dp), intent(inout) :: ab(ldab,*)
end subroutine zlaqhb
#else
module procedure stdlib${ii}$_zlaqhb
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqhb
#:endif
#:endfor
#:endfor
end interface laqhb
interface laqhe
!! LAQHE equilibrates a Hermitian matrix A using the scaling factors
!! in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqhe( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: amax,scond,s(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine claqhe
#else
module procedure stdlib${ii}$_claqhe
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: amax,scond,s(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlaqhe
#else
module procedure stdlib${ii}$_zlaqhe
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqhe
#:endif
#:endfor
#:endfor
end interface laqhe
interface laqhp
!! LAQHP equilibrates a Hermitian matrix A using the scaling factors
!! in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqhp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: amax,scond,s(*)
complex(sp), intent(inout) :: ap(*)
end subroutine claqhp
#else
module procedure stdlib${ii}$_claqhp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqhp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: amax,scond,s(*)
complex(dp), intent(inout) :: ap(*)
end subroutine zlaqhp
#else
module procedure stdlib${ii}$_zlaqhp
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqhp
#:endif
#:endfor
#:endfor
end interface laqhp
interface laqps
!! LAQPS computes a step of QR factorization with column pivoting
!! of a complex M-by-N matrix A by using Blas-3. It tries to factorize
!! NB columns from A starting from the row OFFSET+1, and updates all
!! of the matrix with Blas-3 xGEMM.
!! In some cases, due to catastrophic cancellations, it cannot
!! factorize NB columns. Hence, the actual number of factorized
!! columns is returned in KB.
!! Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, &
ldf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: kb
integer(${ik}$), intent(in) :: lda,ldf,m,n,nb,offset
integer(${ik}$), intent(inout) :: jpvt(*)
real(sp), intent(inout) :: vn1(*),vn2(*)
complex(sp), intent(inout) :: a(lda,*),auxv(*),f(ldf,*)
complex(sp), intent(out) :: tau(*)
end subroutine claqps
#else
module procedure stdlib${ii}$_claqps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, &
ldf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: kb
integer(${ik}$), intent(in) :: lda,ldf,m,n,nb,offset
integer(${ik}$), intent(inout) :: jpvt(*)
real(dp), intent(inout) :: a(lda,*),auxv(*),f(ldf,*),vn1(*),vn2(*)
real(dp), intent(out) :: tau(*)
end subroutine dlaqps
#else
module procedure stdlib${ii}$_dlaqps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, &
ldf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: kb
integer(${ik}$), intent(in) :: lda,ldf,m,n,nb,offset
integer(${ik}$), intent(inout) :: jpvt(*)
real(sp), intent(inout) :: a(lda,*),auxv(*),f(ldf,*),vn1(*),vn2(*)
real(sp), intent(out) :: tau(*)
end subroutine slaqps
#else
module procedure stdlib${ii}$_slaqps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, &
ldf )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: kb
integer(${ik}$), intent(in) :: lda,ldf,m,n,nb,offset
integer(${ik}$), intent(inout) :: jpvt(*)
real(dp), intent(inout) :: vn1(*),vn2(*)
complex(dp), intent(inout) :: a(lda,*),auxv(*),f(ldf,*)
complex(dp), intent(out) :: tau(*)
end subroutine zlaqps
#else
module procedure stdlib${ii}$_zlaqps
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqps
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqps
#:endif
#:endfor
#:endfor
end interface laqps
interface laqr0
!! LAQR0 computes the eigenvalues of a Hessenberg matrix H
!! and, optionally, the matrices T and Z from the Schur decomposition
!! H = Z T Z**H, where T is an upper triangular matrix (the
!! Schur form), and Z is the unitary matrix of Schur vectors.
!! Optionally Z may be postmultiplied into an input unitary
!! matrix Q so that this routine can give the Schur factorization
!! of a matrix A which has been reduced to the Hessenberg form H
!! by the unitary matrix Q: A = Q*H*Q**H = (QZ)*H*(QZ)**H.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(sp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(sp), intent(out) :: w(*),work(*)
end subroutine claqr0
#else
module procedure stdlib${ii}$_claqr0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(dp), intent(inout) :: h(ldh,*),z(ldz,*)
real(dp), intent(out) :: wi(*),work(*),wr(*)
end subroutine dlaqr0
#else
module procedure stdlib${ii}$_dlaqr0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(sp), intent(inout) :: h(ldh,*),z(ldz,*)
real(sp), intent(out) :: wi(*),work(*),wr(*)
end subroutine slaqr0
#else
module procedure stdlib${ii}$_slaqr0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(dp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(dp), intent(out) :: w(*),work(*)
end subroutine zlaqr0
#else
module procedure stdlib${ii}$_zlaqr0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr0
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr0
#:endif
#:endfor
#:endfor
end interface laqr0
interface laqr1
!! Given a 2-by-2 or 3-by-3 matrix H, LAQR1: sets v to a
!! scalar multiple of the first column of the product
!! (*) K = (H - s1*I)*(H - s2*I)
!! scaling to avoid overflows and most underflows.
!! This is useful for starting double implicit shift bulges
!! in the QR algorithm.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqr1( n, h, ldh, s1, s2, v )
import sp,dp,qp,${ik}$,lk
implicit none
complex(sp), intent(in) :: s1,s2,h(ldh,*)
integer(${ik}$), intent(in) :: ldh,n
complex(sp), intent(out) :: v(*)
end subroutine claqr1
#else
module procedure stdlib${ii}$_claqr1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqr1( n, h, ldh, sr1, si1, sr2, si2, v )
import sp,dp,qp,${ik}$,lk
implicit none
real(dp), intent(in) :: si1,si2,sr1,sr2,h(ldh,*)
integer(${ik}$), intent(in) :: ldh,n
real(dp), intent(out) :: v(*)
end subroutine dlaqr1
#else
module procedure stdlib${ii}$_dlaqr1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqr1( n, h, ldh, sr1, si1, sr2, si2, v )
import sp,dp,qp,${ik}$,lk
implicit none
real(sp), intent(in) :: si1,si2,sr1,sr2,h(ldh,*)
integer(${ik}$), intent(in) :: ldh,n
real(sp), intent(out) :: v(*)
end subroutine slaqr1
#else
module procedure stdlib${ii}$_slaqr1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqr1( n, h, ldh, s1, s2, v )
import sp,dp,qp,${ik}$,lk
implicit none
complex(dp), intent(in) :: s1,s2,h(ldh,*)
integer(${ik}$), intent(in) :: ldh,n
complex(dp), intent(out) :: v(*)
end subroutine zlaqr1
#else
module procedure stdlib${ii}$_zlaqr1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr1
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr1
#:endif
#:endfor
#:endfor
end interface laqr1
interface laqr4
!! LAQR4 implements one level of recursion for CLAQR0.
!! It is a complete implementation of the small bulge multi-shift
!! QR algorithm. It may be called by CLAQR0 and, for large enough
!! deflation window size, it may be called by CLAQR3. This
!! subroutine is identical to CLAQR0 except that it calls CLAQR2
!! instead of CLAQR3.
!! LAQR4 computes the eigenvalues of a Hessenberg matrix H
!! and, optionally, the matrices T and Z from the Schur decomposition
!! H = Z T Z**H, where T is an upper triangular matrix (the
!! Schur form), and Z is the unitary matrix of Schur vectors.
!! Optionally Z may be postmultiplied into an input unitary
!! matrix Q so that this routine can give the Schur factorization
!! of a matrix A which has been reduced to the Hessenberg form H
!! by the unitary matrix Q: A = Q*H*Q**H = (QZ)*H*(QZ)**H.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(sp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(sp), intent(out) :: w(*),work(*)
end subroutine claqr4
#else
module procedure stdlib${ii}$_claqr4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(dp), intent(inout) :: h(ldh,*),z(ldz,*)
real(dp), intent(out) :: wi(*),work(*),wr(*)
end subroutine dlaqr4
#else
module procedure stdlib${ii}$_dlaqr4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
real(sp), intent(inout) :: h(ldh,*),z(ldz,*)
real(sp), intent(out) :: wi(*),work(*),wr(*)
end subroutine slaqr4
#else
module procedure stdlib${ii}$_slaqr4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, &
work, lwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihi,ihiz,ilo,iloz,ldh,ldz,lwork,n
integer(${ik}$), intent(out) :: info
logical(lk), intent(in) :: wantt,wantz
complex(dp), intent(inout) :: h(ldh,*),z(ldz,*)
complex(dp), intent(out) :: w(*),work(*)
end subroutine zlaqr4
#else
module procedure stdlib${ii}$_zlaqr4
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr4
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr4
#:endif
#:endfor
#:endfor
end interface laqr4
interface laqr5
!! LAQR5 called by CLAQR0 performs a
!! single small-bulge multi-shift QR sweep.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, &
iloz, ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihiz,iloz,kacc22,kbot,ktop,ldh,ldu,ldv,ldwh,ldwv,&
ldz,n,nh,nshfts,nv
logical(lk), intent(in) :: wantt,wantz
complex(sp), intent(inout) :: h(ldh,*),s(*),z(ldz,*)
complex(sp), intent(out) :: u(ldu,*),v(ldv,*),wh(ldwh,*),wv(ldwv,*)
end subroutine claqr5
#else
module procedure stdlib${ii}$_claqr5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh,&
iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihiz,iloz,kacc22,kbot,ktop,ldh,ldu,ldv,ldwh,ldwv,&
ldz,n,nh,nshfts,nv
logical(lk), intent(in) :: wantt,wantz
real(dp), intent(inout) :: h(ldh,*),si(*),sr(*),z(ldz,*)
real(dp), intent(out) :: u(ldu,*),v(ldv,*),wh(ldwh,*),wv(ldwv,*)
end subroutine dlaqr5
#else
module procedure stdlib${ii}$_dlaqr5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh,&
iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihiz,iloz,kacc22,kbot,ktop,ldh,ldu,ldv,ldwh,ldwv,&
ldz,n,nh,nshfts,nv
logical(lk), intent(in) :: wantt,wantz
real(sp), intent(inout) :: h(ldh,*),si(*),sr(*),z(ldz,*)
real(sp), intent(out) :: u(ldu,*),v(ldv,*),wh(ldwh,*),wv(ldwv,*)
end subroutine slaqr5
#else
module procedure stdlib${ii}$_slaqr5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, &
iloz, ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ihiz,iloz,kacc22,kbot,ktop,ldh,ldu,ldv,ldwh,ldwv,&
ldz,n,nh,nshfts,nv
logical(lk), intent(in) :: wantt,wantz
complex(dp), intent(inout) :: h(ldh,*),s(*),z(ldz,*)
complex(dp), intent(out) :: u(ldu,*),v(ldv,*),wh(ldwh,*),wv(ldwv,*)
end subroutine zlaqr5
#else
module procedure stdlib${ii}$_zlaqr5
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr5
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqr5
#:endif
#:endfor
#:endfor
end interface laqr5
interface laqsb
!! LAQSB equilibrates a symmetric band matrix A using the scaling
!! factors in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(sp), intent(in) :: amax,scond,s(*)
complex(sp), intent(inout) :: ab(ldab,*)
end subroutine claqsb
#else
module procedure stdlib${ii}$_claqsb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(dp), intent(in) :: amax,scond,s(*)
real(dp), intent(inout) :: ab(ldab,*)
end subroutine dlaqsb
#else
module procedure stdlib${ii}$_dlaqsb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(sp), intent(in) :: amax,scond,s(*)
real(sp), intent(inout) :: ab(ldab,*)
end subroutine slaqsb
#else
module procedure stdlib${ii}$_slaqsb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: kd,ldab,n
real(dp), intent(in) :: amax,scond,s(*)
complex(dp), intent(inout) :: ab(ldab,*)
end subroutine zlaqsb
#else
module procedure stdlib${ii}$_zlaqsb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsb
#:endif
#:endfor
#:endfor
end interface laqsb
interface laqsp
!! LAQSP equilibrates a symmetric matrix A using the scaling factors
!! in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqsp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: amax,scond,s(*)
complex(sp), intent(inout) :: ap(*)
end subroutine claqsp
#else
module procedure stdlib${ii}$_claqsp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqsp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: amax,scond,s(*)
real(dp), intent(inout) :: ap(*)
end subroutine dlaqsp
#else
module procedure stdlib${ii}$_dlaqsp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqsp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: amax,scond,s(*)
real(sp), intent(inout) :: ap(*)
end subroutine slaqsp
#else
module procedure stdlib${ii}$_slaqsp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqsp( uplo, n, ap, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: amax,scond,s(*)
complex(dp), intent(inout) :: ap(*)
end subroutine zlaqsp
#else
module procedure stdlib${ii}$_zlaqsp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsp
#:endif
#:endfor
#:endfor
end interface laqsp
interface laqsy
!! LAQSY equilibrates a symmetric matrix A using the scaling factors
!! in the vector S.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqsy( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: amax,scond,s(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine claqsy
#else
module procedure stdlib${ii}$_claqsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqsy( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: amax,scond,s(*)
real(dp), intent(inout) :: a(lda,*)
end subroutine dlaqsy
#else
module procedure stdlib${ii}$_dlaqsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqsy( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(sp), intent(in) :: amax,scond,s(*)
real(sp), intent(inout) :: a(lda,*)
end subroutine slaqsy
#else
module procedure stdlib${ii}$_slaqsy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqsy( uplo, n, a, lda, s, scond, amax, equed )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(out) :: equed
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,n
real(dp), intent(in) :: amax,scond,s(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlaqsy
#else
module procedure stdlib${ii}$_zlaqsy
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsy
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqsy
#:endif
#:endfor
#:endfor
end interface laqsy
interface laqtr
!! LAQTR solves the real quasi-triangular system
!! op(T)*p = scale*c, if LREAL = .TRUE.
!! or the complex quasi-triangular systems
!! op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE.
!! in real arithmetic, where T is upper quasi-triangular.
!! If LREAL = .FALSE., then the first diagonal block of T must be
!! 1 by 1, B is the specially structured matrix
!! B = [ b(1) b(2) ... b(n) ]
!! [ w ]
!! [ w ]
!! [ . ]
!! [ w ]
!! op(A) = A or A**T, A**T denotes the transpose of
!! matrix A.
!! On input, X = [ c ]. On output, X = [ p ].
!! [ d ] [ q ]
!! This subroutine is designed for the condition number estimation
!! in routine DTRSNA.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: lreal,ltran
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldt,n
real(dp), intent(out) :: scale,work(*)
real(dp), intent(in) :: w,b(*),t(ldt,*)
real(dp), intent(inout) :: x(*)
end subroutine dlaqtr
#else
module procedure stdlib${ii}$_dlaqtr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: lreal,ltran
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldt,n
real(sp), intent(out) :: scale,work(*)
real(sp), intent(in) :: w,b(*),t(ldt,*)
real(sp), intent(inout) :: x(*)
end subroutine slaqtr
#else
module procedure stdlib${ii}$_slaqtr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqtr
#:endif
#:endfor
#:endfor
end interface laqtr
interface laqz0
!! LAQZ0 computes the eigenvalues of a matrix pair (H,T),
!! where H is an upper Hessenberg matrix and T is upper triangular,
!! using the double-shift QZ method.
!! Matrix pairs of this type are produced by the reduction to
!! generalized upper Hessenberg form of a matrix pair (A,B):
!! A = Q1*H*Z1**H, B = Q1*T*Z1**H,
!! as computed by CGGHRD.
!! If JOB='S', then the Hessenberg-triangular pair (H,T) is
!! also reduced to generalized Schur form,
!! H = Q*S*Z**H, T = Q*P*Z**H,
!! where Q and Z are unitary matrices, P and S are an upper triangular
!! matrices.
!! Optionally, the unitary matrix Q from the generalized Schur
!! factorization may be postmultiplied into an input matrix Q1, and the
!! unitary matrix Z may be postmultiplied into an input matrix Z1.
!! If Q1 and Z1 are the unitary matrices from CGGHRD that reduced
!! the matrix pair (A,B) to generalized upper Hessenberg form, then the
!! output matrices Q1*Q and Z1*Z are the unitary factors from the
!! generalized Schur factorization of (A,B):
!! A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
!! To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
!! of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
!! complex and beta real.
!! If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
!! generalized nonsymmetric eigenvalue problem (GNEP)
!! A*x = lambda*B*x
!! and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
!! alternate form of the GNEP
!! mu*A*y = B*y.
!! Eigenvalues can be read directly from the generalized Schur
!! form:
!! alpha = S(i,i), beta = P(i,i).
!! Ref: C.B. Moler
!! Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
!! pp. 241--256.
!! Ref: B. Kagstrom, D. Kressner, "Multishift Variants of the QZ
!! Algorithm with Aggressive Early Deflation", SIAM J. Numer.
!! Anal., 29(2006), pp. 199--227.
!! Ref: T. Steel, D. Camps, K. Meerbergen, R. Vandebril "A multishift,
!! multipole rational QZ method with agressive early deflation"
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
recursive subroutine claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, &
alpha, beta, q, ldq, z,ldz, work, lwork, rwork, rec,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: wants,wantq,wantz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,rec
integer(${ik}$), intent(out) :: info
complex(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
complex(sp), intent(inout) :: alpha(*),beta(*),work(*)
real(sp), intent(out) :: rwork(*)
end subroutine claqz0
#else
module procedure stdlib${ii}$_claqz0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
recursive subroutine dlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, &
alphar, alphai, beta,q, ldq, z, ldz, work, lwork, rec,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: wants,wantq,wantz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,rec
integer(${ik}$), intent(out) :: info
real(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
real(dp), intent(inout) :: alphar(*),alphai(*),beta(*),work(*)
end subroutine dlaqz0
#else
module procedure stdlib${ii}$_dlaqz0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
recursive subroutine slaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, &
alphar, alphai, beta,q, ldq, z, ldz, work, lwork, rec,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: wants,wantq,wantz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,rec
integer(${ik}$), intent(out) :: info
real(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
real(sp), intent(inout) :: alphar(*),alphai(*),beta(*),work(*)
end subroutine slaqz0
#else
module procedure stdlib${ii}$_slaqz0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
recursive subroutine zlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, &
alpha, beta, q, ldq, z,ldz, work, lwork, rwork, rec,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: wants,wantq,wantz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,rec
integer(${ik}$), intent(out) :: info
complex(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
complex(dp), intent(inout) :: alpha(*),beta(*),work(*)
real(dp), intent(out) :: rwork(*)
end subroutine zlaqz0
#else
module procedure stdlib${ii}$_zlaqz0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqz0
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqz0
#:endif
#:endfor
#:endfor
end interface laqz0
interface laqz1
!! LAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, &
qstart, q, ldq, nz, zstart, z, ldz )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ilq,ilz
integer(${ik}$), intent(in) :: k,lda,ldb,ldq,ldz,istartm,istopm,nq,nz,qstart,&
zstart,ihi
complex(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine claqz1
#else
module procedure stdlib${ii}$_claqz1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb
real(dp), intent(in) :: a(lda,*),b(ldb,*),sr1,sr2,si,beta1,beta2
real(dp), intent(out) :: v(*)
end subroutine dlaqz1
#else
module procedure stdlib${ii}$_dlaqz1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb
real(sp), intent(in) :: a(lda,*),b(ldb,*),sr1,sr2,si,beta1,beta2
real(sp), intent(out) :: v(*)
end subroutine slaqz1
#else
module procedure stdlib${ii}$_slaqz1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, &
qstart, q, ldq, nz, zstart, z, ldz )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ilq,ilz
integer(${ik}$), intent(in) :: k,lda,ldb,ldq,ldz,istartm,istopm,nq,nz,qstart,&
zstart,ihi
complex(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*)
end subroutine zlaqz1
#else
module procedure stdlib${ii}$_zlaqz1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqz1
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqz1
#:endif
#:endfor
#:endfor
end interface laqz1
interface laqz4
!! LAQZ4 Executes a single multishift QZ sweep
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr,&
si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ilschur,ilq,ilz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,nshifts,&
nblock_desired,ldqc,ldzc
real(dp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*),qc(ldqc,*),zc(&
ldzc,*)
real(dp), intent(inout) :: work(*)
real(dp), intent(inout) :: sr(*),si(*),ss(*)
integer(${ik}$), intent(out) :: info
end subroutine dlaqz4
#else
module procedure stdlib${ii}$_dlaqz4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr,&
si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ilschur,ilq,ilz
integer(${ik}$), intent(in) :: n,ilo,ihi,lda,ldb,ldq,ldz,lwork,nshifts,&
nblock_desired,ldqc,ldzc
real(sp), intent(inout) :: a(lda,*),b(ldb,*),q(ldq,*),z(ldz,*),qc(ldqc,*),zc(&
ldzc,*)
real(sp), intent(inout) :: work(*)
real(sp), intent(inout) :: sr(*),si(*),ss(*)
integer(${ik}$), intent(out) :: info
end subroutine slaqz4
#else
module procedure stdlib${ii}$_slaqz4
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laqz4
#:endif
#:endfor
#:endfor
end interface laqz4
interface lar1v
!! LAR1V computes the (scaled) r-th column of the inverse of
!! the sumbmatrix in rows B1 through BN of the tridiagonal matrix
!! L D L**T - sigma I. When sigma is close to an eigenvalue, the
!! computed vector is an accurate eigenvector. Usually, r corresponds
!! to the index where the eigenvector is largest in magnitude.
!! The following steps accomplish this computation :
!! (a) Stationary qd transform, L D L**T - sigma I = L(+) D(+) L(+)**T,
!! (b) Progressive qd transform, L D L**T - sigma I = U(-) D(-) U(-)**T,
!! (c) Computation of the diagonal elements of the inverse of
!! L D L**T - sigma I by combining the above transforms, and choosing
!! r as the index where the diagonal of the inverse is (one of the)
!! largest in magnitude.
!! (d) Computation of the (scaled) r-th column of the inverse using the
!! twisted factorization obtained by combining the top part of the
!! the stationary and the bottom part of the progressive transform.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,&
negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantnc
integer(${ik}$), intent(in) :: b1,bn,n
integer(${ik}$), intent(out) :: negcnt,isuppz(*)
integer(${ik}$), intent(inout) :: r
real(sp), intent(in) :: gaptol,lambda,pivmin,d(*),l(*),ld(*),lld(*)
real(sp), intent(out) :: mingma,nrminv,resid,rqcorr,ztz,work(*)
complex(sp), intent(inout) :: z(*)
end subroutine clar1v
#else
module procedure stdlib${ii}$_clar1v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,&
negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantnc
integer(${ik}$), intent(in) :: b1,bn,n
integer(${ik}$), intent(out) :: negcnt,isuppz(*)
integer(${ik}$), intent(inout) :: r
real(dp), intent(in) :: gaptol,lambda,pivmin,d(*),l(*),ld(*),lld(*)
real(dp), intent(out) :: mingma,nrminv,resid,rqcorr,ztz,work(*)
real(dp), intent(inout) :: z(*)
end subroutine dlar1v
#else
module procedure stdlib${ii}$_dlar1v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,&
negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantnc
integer(${ik}$), intent(in) :: b1,bn,n
integer(${ik}$), intent(out) :: negcnt,isuppz(*)
integer(${ik}$), intent(inout) :: r
real(sp), intent(in) :: gaptol,lambda,pivmin,d(*),l(*),ld(*),lld(*)
real(sp), intent(out) :: mingma,nrminv,resid,rqcorr,ztz,work(*)
real(sp), intent(inout) :: z(*)
end subroutine slar1v
#else
module procedure stdlib${ii}$_slar1v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,&
negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: wantnc
integer(${ik}$), intent(in) :: b1,bn,n
integer(${ik}$), intent(out) :: negcnt,isuppz(*)
integer(${ik}$), intent(inout) :: r
real(dp), intent(in) :: gaptol,lambda,pivmin,d(*),l(*),ld(*),lld(*)
real(dp), intent(out) :: mingma,nrminv,resid,rqcorr,ztz,work(*)
complex(dp), intent(inout) :: z(*)
end subroutine zlar1v
#else
module procedure stdlib${ii}$_zlar1v
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lar1v
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lar1v
#:endif
#:endfor
#:endfor
end interface lar1v
interface lar2v
!! LAR2V applies a vector of complex plane rotations with real cosines
!! from both sides to a sequence of 2-by-2 complex Hermitian matrices,
!! defined by the elements of the vectors x, y and z. For i = 1,2,...,n
!! ( x(i) z(i) ) :=
!! ( conjg(z(i)) y(i) )
!! ( c(i) conjg(s(i)) ) ( x(i) z(i) ) ( c(i) -conjg(s(i)) )
!! ( -s(i) c(i) ) ( conjg(z(i)) y(i) ) ( s(i) c(i) )
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clar2v( n, x, y, z, incx, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,n
real(sp), intent(in) :: c(*)
complex(sp), intent(in) :: s(*)
complex(sp), intent(inout) :: x(*),y(*),z(*)
end subroutine clar2v
#else
module procedure stdlib${ii}$_clar2v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlar2v( n, x, y, z, incx, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,n
real(dp), intent(in) :: c(*),s(*)
real(dp), intent(inout) :: x(*),y(*),z(*)
end subroutine dlar2v
#else
module procedure stdlib${ii}$_dlar2v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slar2v( n, x, y, z, incx, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,n
real(sp), intent(in) :: c(*),s(*)
real(sp), intent(inout) :: x(*),y(*),z(*)
end subroutine slar2v
#else
module procedure stdlib${ii}$_slar2v
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlar2v( n, x, y, z, incx, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,n
real(dp), intent(in) :: c(*)
complex(dp), intent(in) :: s(*)
complex(dp), intent(inout) :: x(*),y(*),z(*)
end subroutine zlar2v
#else
module procedure stdlib${ii}$_zlar2v
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lar2v
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lar2v
#:endif
#:endfor
#:endfor
end interface lar2v
interface larcm
!! LARCM performs a very simple matrix-matrix multiplication:
!! C := A * B,
!! where A is M by M and real; B is M by N and complex;
!! C is M by N and complex.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarcm( m, n, a, lda, b, ldb, c, ldc, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
real(sp), intent(in) :: a(lda,*)
real(sp), intent(out) :: rwork(*)
complex(sp), intent(in) :: b(ldb,*)
complex(sp), intent(out) :: c(ldc,*)
end subroutine clarcm
#else
module procedure stdlib${ii}$_clarcm
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarcm( m, n, a, lda, b, ldb, c, ldc, rwork )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: lda,ldb,ldc,m,n
real(dp), intent(in) :: a(lda,*)
real(dp), intent(out) :: rwork(*)
complex(dp), intent(in) :: b(ldb,*)
complex(dp), intent(out) :: c(ldc,*)
end subroutine zlarcm
#else
module procedure stdlib${ii}$_zlarcm
#endif
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larcm
#:endif
#:endfor
#:endfor
end interface larcm
interface larf
!! LARF applies a complex elementary reflector H to a complex M-by-N
!! matrix C, from either the left or the right. H is represented in the
!! form
!! H = I - tau * v * v**H
!! where tau is a complex scalar and v is a complex vector.
!! If tau = 0, then H is taken to be the unit matrix.
!! To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
!! tau.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarf( side, m, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,ldc,m,n
complex(sp), intent(in) :: tau,v(*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine clarf
#else
module procedure stdlib${ii}$_clarf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarf( side, m, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,ldc,m,n
real(dp), intent(in) :: tau,v(*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dlarf
#else
module procedure stdlib${ii}$_dlarf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarf( side, m, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,ldc,m,n
real(sp), intent(in) :: tau,v(*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine slarf
#else
module procedure stdlib${ii}$_slarf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarf( side, m, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,ldc,m,n
complex(dp), intent(in) :: tau,v(*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zlarf
#else
module procedure stdlib${ii}$_zlarf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larf
#:endif
#:endfor
#:endfor
end interface larf
interface larfb
!! LARFB applies a complex block reflector H or its transpose H**H to a
!! complex M-by-N matrix C, from either the left or the right.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,ldc,ldt,ldv,ldwork,m,n
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(in) :: t(ldt,*),v(ldv,*)
complex(sp), intent(out) :: work(ldwork,*)
end subroutine clarfb
#else
module procedure stdlib${ii}$_clarfb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,ldc,ldt,ldv,ldwork,m,n
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(in) :: t(ldt,*),v(ldv,*)
real(dp), intent(out) :: work(ldwork,*)
end subroutine dlarfb
#else
module procedure stdlib${ii}$_dlarfb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,ldc,ldt,ldv,ldwork,m,n
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(in) :: t(ldt,*),v(ldv,*)
real(sp), intent(out) :: work(ldwork,*)
end subroutine slarfb
#else
module procedure stdlib${ii}$_slarfb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,ldc,ldt,ldv,ldwork,m,n
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(in) :: t(ldt,*),v(ldv,*)
complex(dp), intent(out) :: work(ldwork,*)
end subroutine zlarfb
#else
module procedure stdlib${ii}$_zlarfb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfb
#:endif
#:endfor
#:endfor
end interface larfb
interface larfb_gett
!! LARFB_GETT applies a complex Householder block reflector H from the
!! left to a complex (K+M)-by-N "triangular-pentagonal" matrix
!! composed of two block matrices: an upper trapezoidal K-by-N matrix A
!! stored in the array A, and a rectangular M-by-(N-K) matrix B, stored
!! in the array B. The block reflector H is stored in a compact
!! WY-representation, where the elementary reflectors are in the
!! arrays A, B and T. See Further Details section.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: ident
integer(${ik}$), intent(in) :: k,lda,ldb,ldt,ldwork,m,n
complex(sp), intent(inout) :: a(lda,*),b(ldb,*)
complex(sp), intent(in) :: t(ldt,*)
complex(sp), intent(out) :: work(ldwork,*)
end subroutine clarfb_gett
#else
module procedure stdlib${ii}$_clarfb_gett
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: ident
integer(${ik}$), intent(in) :: k,lda,ldb,ldt,ldwork,m,n
real(dp), intent(inout) :: a(lda,*),b(ldb,*)
real(dp), intent(in) :: t(ldt,*)
real(dp), intent(out) :: work(ldwork,*)
end subroutine dlarfb_gett
#else
module procedure stdlib${ii}$_dlarfb_gett
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: ident
integer(${ik}$), intent(in) :: k,lda,ldb,ldt,ldwork,m,n
real(sp), intent(inout) :: a(lda,*),b(ldb,*)
real(sp), intent(in) :: t(ldt,*)
real(sp), intent(out) :: work(ldwork,*)
end subroutine slarfb_gett
#else
module procedure stdlib${ii}$_slarfb_gett
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: ident
integer(${ik}$), intent(in) :: k,lda,ldb,ldt,ldwork,m,n
complex(dp), intent(inout) :: a(lda,*),b(ldb,*)
complex(dp), intent(in) :: t(ldt,*)
complex(dp), intent(out) :: work(ldwork,*)
end subroutine zlarfb_gett
#else
module procedure stdlib${ii}$_zlarfb_gett
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfb_gett
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfb_gett
#:endif
#:endfor
#:endfor
end interface larfb_gett
interface larfg
!! LARFG generates a complex elementary reflector H of order n, such
!! that
!! H**H * ( alpha ) = ( beta ), H**H * H = I.
!! ( x ) ( 0 )
!! where alpha and beta are scalars, with beta real, and x is an
!! (n-1)-element complex vector. H is represented in the form
!! H = I - tau * ( 1 ) * ( 1 v**H ) ,
!! ( v )
!! where tau is a complex scalar and v is a complex (n-1)-element
!! vector. Note that H is not hermitian.
!! If the elements of x are all zero and alpha is real, then tau = 0
!! and H is taken to be the unit matrix.
!! Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarfg( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(inout) :: alpha,x(*)
complex(sp), intent(out) :: tau
end subroutine clarfg
#else
module procedure stdlib${ii}$_clarfg
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarfg( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(inout) :: alpha,x(*)
real(dp), intent(out) :: tau
end subroutine dlarfg
#else
module procedure stdlib${ii}$_dlarfg
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarfg( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(inout) :: alpha,x(*)
real(sp), intent(out) :: tau
end subroutine slarfg
#else
module procedure stdlib${ii}$_slarfg
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarfg( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(inout) :: alpha,x(*)
complex(dp), intent(out) :: tau
end subroutine zlarfg
#else
module procedure stdlib${ii}$_zlarfg
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfg
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfg
#:endif
#:endfor
#:endfor
end interface larfg
interface larfgp
!! LARFGP generates a complex elementary reflector H of order n, such
!! that
!! H**H * ( alpha ) = ( beta ), H**H * H = I.
!! ( x ) ( 0 )
!! where alpha and beta are scalars, beta is real and non-negative, and
!! x is an (n-1)-element complex vector. H is represented in the form
!! H = I - tau * ( 1 ) * ( 1 v**H ) ,
!! ( v )
!! where tau is a complex scalar and v is a complex (n-1)-element
!! vector. Note that H is not hermitian.
!! If the elements of x are all zero and alpha is real, then tau = 0
!! and H is taken to be the unit matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine clarfgp( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(sp), intent(inout) :: alpha,x(*)
complex(sp), intent(out) :: tau
end subroutine clarfgp
#else
module procedure stdlib${ii}$_clarfgp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine dlarfgp( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(inout) :: alpha,x(*)
real(dp), intent(out) :: tau
end subroutine dlarfgp
#else
module procedure stdlib${ii}$_dlarfgp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine slarfgp( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(inout) :: alpha,x(*)
real(sp), intent(out) :: tau
end subroutine slarfgp
#else
module procedure stdlib${ii}$_slarfgp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
subroutine zlarfgp( n, alpha, x, incx, tau )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
complex(dp), intent(inout) :: alpha,x(*)
complex(dp), intent(out) :: tau
end subroutine zlarfgp
#else
module procedure stdlib${ii}$_zlarfgp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfgp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfgp
#:endif
#:endfor
#:endfor
end interface larfgp
interface larft
!! LARFT forms the triangular factor T of a complex block reflector H
!! of order n, which is defined as a product of k elementary reflectors.
!! If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
!! If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
!! If STOREV = 'C', the vector which defines the elementary reflector
!! H(i) is stored in the i-th column of the array V, and
!! H = I - V * T * V**H
!! If STOREV = 'R', the vector which defines the elementary reflector
!! H(i) is stored in the i-th row of the array V, and
!! H = I - V**H * T * V
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarft( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
complex(sp), intent(out) :: t(ldt,*)
complex(sp), intent(in) :: tau(*),v(ldv,*)
end subroutine clarft
#else
module procedure stdlib${ii}$_clarft
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarft( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
real(dp), intent(out) :: t(ldt,*)
real(dp), intent(in) :: tau(*),v(ldv,*)
end subroutine dlarft
#else
module procedure stdlib${ii}$_dlarft
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarft( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
real(sp), intent(out) :: t(ldt,*)
real(sp), intent(in) :: tau(*),v(ldv,*)
end subroutine slarft
#else
module procedure stdlib${ii}$_slarft
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarft( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
complex(dp), intent(out) :: t(ldt,*)
complex(dp), intent(in) :: tau(*),v(ldv,*)
end subroutine zlarft
#else
module procedure stdlib${ii}$_zlarft
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larft
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larft
#:endif
#:endfor
#:endfor
end interface larft
interface larfy
!! LARFY applies an elementary reflector, or Householder matrix, H,
!! to an n x n Hermitian matrix C, from both the left and the right.
!! H is represented in the form
!! H = I - tau * v * v'
!! where tau is a scalar and v is a vector.
!! If tau is zero, then H is taken to be the unit matrix.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarfy( uplo, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: incv,ldc,n
complex(sp), intent(in) :: tau,v(*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine clarfy
#else
module procedure stdlib${ii}$_clarfy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarfy( uplo, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: incv,ldc,n
real(dp), intent(in) :: tau,v(*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dlarfy
#else
module procedure stdlib${ii}$_dlarfy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarfy( uplo, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: incv,ldc,n
real(sp), intent(in) :: tau,v(*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine slarfy
#else
module procedure stdlib${ii}$_slarfy
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarfy( uplo, n, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: incv,ldc,n
complex(dp), intent(in) :: tau,v(*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zlarfy
#else
module procedure stdlib${ii}$_zlarfy
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfy
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larfy
#:endif
#:endfor
#:endfor
end interface larfy
interface largv
!! LARGV generates a vector of complex plane rotations with real
!! cosines, determined by elements of the complex vectors x and y.
!! For i = 1,2,...,n
!! ( c(i) s(i) ) ( x(i) ) = ( r(i) )
!! ( -conjg(s(i)) c(i) ) ( y(i) ) = ( 0 )
!! where c(i)**2 + ABS(s(i))**2 = 1
!! The following conventions are used (these are the same as in CLARTG,
!! but differ from the BLAS1 routine CROTG):
!! If y(i)=0, then c(i)=1 and s(i)=0.
!! If x(i)=0, then c(i)=0 and s(i) is chosen so that r(i) is real.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clargv( n, x, incx, y, incy, c, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(sp), intent(out) :: c(*)
complex(sp), intent(inout) :: x(*),y(*)
end subroutine clargv
#else
module procedure stdlib${ii}$_clargv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlargv( n, x, incx, y, incy, c, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(dp), intent(out) :: c(*)
real(dp), intent(inout) :: x(*),y(*)
end subroutine dlargv
#else
module procedure stdlib${ii}$_dlargv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slargv( n, x, incx, y, incy, c, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(sp), intent(out) :: c(*)
real(sp), intent(inout) :: x(*),y(*)
end subroutine slargv
#else
module procedure stdlib${ii}$_slargv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlargv( n, x, incx, y, incy, c, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(dp), intent(out) :: c(*)
complex(dp), intent(inout) :: x(*),y(*)
end subroutine zlargv
#else
module procedure stdlib${ii}$_zlargv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$largv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$largv
#:endif
#:endfor
#:endfor
end interface largv
interface larnv
!! LARNV returns a vector of n random complex numbers from a uniform or
!! normal distribution.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarnv( idist, iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: idist,n
integer(${ik}$), intent(inout) :: iseed(4)
complex(sp), intent(out) :: x(*)
end subroutine clarnv
#else
module procedure stdlib${ii}$_clarnv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarnv( idist, iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: idist,n
integer(${ik}$), intent(inout) :: iseed(4)
real(dp), intent(out) :: x(*)
end subroutine dlarnv
#else
module procedure stdlib${ii}$_dlarnv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarnv( idist, iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: idist,n
integer(${ik}$), intent(inout) :: iseed(4)
real(sp), intent(out) :: x(*)
end subroutine slarnv
#else
module procedure stdlib${ii}$_slarnv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarnv( idist, iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: idist,n
integer(${ik}$), intent(inout) :: iseed(4)
complex(dp), intent(out) :: x(*)
end subroutine zlarnv
#else
module procedure stdlib${ii}$_zlarnv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larnv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larnv
#:endif
#:endfor
#:endfor
end interface larnv
interface larra
!! Compute the splitting points with threshold SPLTOL.
!! LARRA sets any "small" off-diagonal elements to zero.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,nsplit,isplit(*)
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: spltol,tnrm,d(*)
real(dp), intent(inout) :: e(*),e2(*)
end subroutine dlarra
#else
module procedure stdlib${ii}$_dlarra
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,nsplit,isplit(*)
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: spltol,tnrm,d(*)
real(sp), intent(inout) :: e(*),e2(*)
end subroutine slarra
#else
module procedure stdlib${ii}$_slarra
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larra
#:endif
#:endfor
#:endfor
end interface larra
interface larrb
!! Given the relatively robust representation(RRR) L D L^T, LARRB:
!! does "limited" bisection to refine the eigenvalues of L D L^T,
!! W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
!! guesses for these eigenvalues are input in W, the corresponding estimate
!! of the error in these guesses and their gaps are input in WERR
!! and WGAP, respectively. During bisection, intervals
!! [left, right] are maintained by storing their mid-points and
!! semi-widths in the arrays W and WERR respectively.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, &
werr, work, iwork,pivmin, spdiam, twist, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ifirst,ilast,n,offset,twist
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: pivmin,rtol1,rtol2,spdiam,d(*),lld(*)
real(dp), intent(inout) :: w(*),werr(*),wgap(*)
real(dp), intent(out) :: work(*)
end subroutine dlarrb
#else
module procedure stdlib${ii}$_dlarrb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, &
werr, work, iwork,pivmin, spdiam, twist, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ifirst,ilast,n,offset,twist
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: pivmin,rtol1,rtol2,spdiam,d(*),lld(*)
real(sp), intent(inout) :: w(*),werr(*),wgap(*)
real(sp), intent(out) :: work(*)
end subroutine slarrb
#else
module procedure stdlib${ii}$_slarrb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrb
#:endif
#:endfor
#:endfor
end interface larrb
interface larrc
!! Find the number of eigenvalues of the symmetric tridiagonal matrix T
!! that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
!! if JOBT = 'L'.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobt
integer(${ik}$), intent(out) :: eigcnt,info,lcnt,rcnt
integer(${ik}$), intent(in) :: n
real(dp), intent(in) :: pivmin,vl,vu,d(*),e(*)
end subroutine dlarrc
#else
module procedure stdlib${ii}$_dlarrc
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: jobt
integer(${ik}$), intent(out) :: eigcnt,info,lcnt,rcnt
integer(${ik}$), intent(in) :: n
real(sp), intent(in) :: pivmin,vl,vu,d(*),e(*)
end subroutine slarrc
#else
module procedure stdlib${ii}$_slarrc
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrc
#:endif
#:endfor
#:endfor
end interface larrc
interface larrd
!! LARRD computes the eigenvalues of a symmetric tridiagonal
!! matrix T to suitable accuracy. This is an auxiliary code to be
!! called from DSTEMR.
!! The user may ask for all eigenvalues, all eigenvalues
!! in the half-open interval (VL, VU], or the IL-th through IU-th
!! eigenvalues.
!! To avoid overflow, the matrix must be scaled so that its
!! largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
!! accuracy, it should not be much smaller than that.
!! See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
!! Matrix", Report CS41, Computer Science Dept., Stanford
!! University, July 21, 1966.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, &
pivmin, nsplit, isplit,m, w, werr, wl, wu, iblock, indexw,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: order,range
integer(${ik}$), intent(in) :: il,iu,n,nsplit,isplit(*)
integer(${ik}$), intent(out) :: info,m,iblock(*),indexw(*),iwork(*)
real(dp), intent(in) :: pivmin,reltol,vl,vu,d(*),e(*),e2(*),gers(*)
real(dp), intent(out) :: wl,wu,w(*),werr(*),work(*)
end subroutine dlarrd
#else
module procedure stdlib${ii}$_dlarrd
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, &
pivmin, nsplit, isplit,m, w, werr, wl, wu, iblock, indexw,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: order,range
integer(${ik}$), intent(in) :: il,iu,n,nsplit,isplit(*)
integer(${ik}$), intent(out) :: info,m,iblock(*),indexw(*),iwork(*)
real(sp), intent(in) :: pivmin,reltol,vl,vu,d(*),e(*),e2(*),gers(*)
real(sp), intent(out) :: wl,wu,w(*),werr(*),work(*)
end subroutine slarrd
#else
module procedure stdlib${ii}$_slarrd
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrd
#:endif
#:endfor
#:endfor
end interface larrd
interface larre
!! To find the desired eigenvalues of a given real symmetric
!! tridiagonal matrix T, LARRE: sets any "small" off-diagonal
!! elements to zero, and for each unreduced block T_i, it finds
!! (a) a suitable shift at one end of the block's spectrum,
!! (b) the base representation, T_i - sigma_i I = L_i D_i L_i^T, and
!! (c) eigenvalues of each L_i D_i L_i^T.
!! The representations and eigenvalues found are then used by
!! DSTEMR to compute the eigenvectors of T.
!! The accuracy varies depending on whether bisection is used to
!! find a few eigenvalues or the dqds algorithm (subroutine DLASQ2) to
!! conpute all and then discard any unwanted one.
!! As an added benefit, LARRE also outputs the n
!! Gerschgorin intervals for the matrices L_i D_i L_i^T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, &
nsplit, isplit, m,w, werr, wgap, iblock, indexw, gers, pivmin,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: range
integer(${ik}$), intent(in) :: il,iu,n
integer(${ik}$), intent(out) :: info,m,nsplit,iblock(*),isplit(*),iwork(*),&
indexw(*)
real(dp), intent(out) :: pivmin,gers(*),w(*),werr(*),wgap(*),work(*)
real(dp), intent(in) :: rtol1,rtol2,spltol
real(dp), intent(inout) :: vl,vu,d(*),e(*),e2(*)
end subroutine dlarre
#else
module procedure stdlib${ii}$_dlarre
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, &
nsplit, isplit, m,w, werr, wgap, iblock, indexw, gers, pivmin,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: range
integer(${ik}$), intent(in) :: il,iu,n
integer(${ik}$), intent(out) :: info,m,nsplit,iblock(*),isplit(*),iwork(*),&
indexw(*)
real(sp), intent(out) :: pivmin,gers(*),w(*),werr(*),wgap(*),work(*)
real(sp), intent(in) :: rtol1,rtol2,spltol
real(sp), intent(inout) :: vl,vu,d(*),e(*),e2(*)
end subroutine slarre
#else
module procedure stdlib${ii}$_slarre
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larre
#:endif
#:endfor
#:endfor
end interface larre
interface larrf
!! Given the initial representation L D L^T and its cluster of close
!! eigenvalues (in a relative measure), W( CLSTRT ), W( CLSTRT+1 ), ...
!! W( CLEND ), LARRF: finds a new relatively robust representation
!! L D L^T - SIGMA I = L(+) D(+) L(+)^T such that at least one of the
!! eigenvalues of L(+) D(+) L(+)^T is relatively isolated.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, &
clgapr, pivmin, sigma,dplus, lplus, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: clstrt,clend,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: clgapl,clgapr,pivmin,spdiam,d(*),l(*),ld(*),w(*),werr(&
*)
real(dp), intent(out) :: sigma,dplus(*),lplus(*),work(*)
real(dp), intent(inout) :: wgap(*)
end subroutine dlarrf
#else
module procedure stdlib${ii}$_dlarrf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, &
clgapr, pivmin, sigma,dplus, lplus, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: clstrt,clend,n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: clgapl,clgapr,pivmin,spdiam,d(*),l(*),ld(*),w(*),werr(&
*)
real(sp), intent(out) :: sigma,dplus(*),lplus(*),work(*)
real(sp), intent(inout) :: wgap(*)
end subroutine slarrf
#else
module procedure stdlib${ii}$_slarrf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrf
#:endif
#:endfor
#:endfor
end interface larrf
interface larrj
!! Given the initial eigenvalue approximations of T, LARRJ:
!! does bisection to refine the eigenvalues of T,
!! W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
!! guesses for these eigenvalues are input in W, the corresponding estimate
!! of the error in these guesses in WERR. During bisection, intervals
!! [left, right] are maintained by storing their mid-points and
!! semi-widths in the arrays W and WERR respectively.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,&
pivmin, spdiam, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ifirst,ilast,n,offset
integer(${ik}$), intent(out) :: info,iwork(*)
real(dp), intent(in) :: pivmin,rtol,spdiam,d(*),e2(*)
real(dp), intent(inout) :: w(*),werr(*)
real(dp), intent(out) :: work(*)
end subroutine dlarrj
#else
module procedure stdlib${ii}$_dlarrj
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,&
pivmin, spdiam, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ifirst,ilast,n,offset
integer(${ik}$), intent(out) :: info,iwork(*)
real(sp), intent(in) :: pivmin,rtol,spdiam,d(*),e2(*)
real(sp), intent(inout) :: w(*),werr(*)
real(sp), intent(out) :: work(*)
end subroutine slarrj
#else
module procedure stdlib${ii}$_slarrj
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrj
#:endif
#:endfor
#:endfor
end interface larrj
interface larrk
!! LARRK computes one eigenvalue of a symmetric tridiagonal
!! matrix T to suitable accuracy. This is an auxiliary code to be
!! called from DSTEMR.
!! To avoid overflow, the matrix must be scaled so that its
!! largest element is no greater than overflow**(1/2) * underflow**(1/4) in absolute value, and for greatest
!! accuracy, it should not be much smaller than that.
!! See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
!! Matrix", Report CS41, Computer Science Dept., Stanford
!! University, July 21, 1966.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: iw,n
real(dp), intent(in) :: pivmin,reltol,gl,gu,d(*),e2(*)
real(dp), intent(out) :: w,werr
end subroutine dlarrk
#else
module procedure stdlib${ii}$_dlarrk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: iw,n
real(sp), intent(in) :: pivmin,reltol,gl,gu,d(*),e2(*)
real(sp), intent(out) :: w,werr
end subroutine slarrk
#else
module procedure stdlib${ii}$_slarrk
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrk
#:endif
#:endfor
#:endfor
end interface larrk
interface larrr
!! Perform tests to decide whether the symmetric tridiagonal matrix T
!! warrants expensive computations which guarantee high relative accuracy
!! in the eigenvalues.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrr( n, d, e, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: d(*)
real(dp), intent(inout) :: e(*)
end subroutine dlarrr
#else
module procedure stdlib${ii}$_dlarrr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrr( n, d, e, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: d(*)
real(sp), intent(inout) :: e(*)
end subroutine slarrr
#else
module procedure stdlib${ii}$_slarrr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrr
#:endif
#:endfor
#:endfor
end interface larrr
interface larrv
!! LARRV computes the eigenvectors of the tridiagonal matrix
!! T = L D L**T given L, D and APPROXIMATIONS to the eigenvalues of L D L**T.
!! The input eigenvalues should have been computed by SLARRE.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, &
rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: dol,dou,ldz,m,n,iblock(*),indexw(*),isplit(*)
integer(${ik}$), intent(out) :: info,isuppz(*),iwork(*)
real(sp), intent(in) :: minrgp,pivmin,vl,vu,gers(*)
real(sp), intent(inout) :: rtol1,rtol2,d(*),l(*),w(*),werr(*),wgap(*)
real(sp), intent(out) :: work(*)
complex(sp), intent(out) :: z(ldz,*)
end subroutine clarrv
#else
module procedure stdlib${ii}$_clarrv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, &
rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: dol,dou,ldz,m,n,iblock(*),indexw(*),isplit(*)
integer(${ik}$), intent(out) :: info,isuppz(*),iwork(*)
real(dp), intent(in) :: minrgp,pivmin,vl,vu,gers(*)
real(dp), intent(inout) :: rtol1,rtol2,d(*),l(*),w(*),werr(*),wgap(*)
real(dp), intent(out) :: work(*),z(ldz,*)
end subroutine dlarrv
#else
module procedure stdlib${ii}$_dlarrv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, &
rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: dol,dou,ldz,m,n,iblock(*),indexw(*),isplit(*)
integer(${ik}$), intent(out) :: info,isuppz(*),iwork(*)
real(sp), intent(in) :: minrgp,pivmin,vl,vu,gers(*)
real(sp), intent(inout) :: rtol1,rtol2,d(*),l(*),w(*),werr(*),wgap(*)
real(sp), intent(out) :: work(*),z(ldz,*)
end subroutine slarrv
#else
module procedure stdlib${ii}$_slarrv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, &
rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: dol,dou,ldz,m,n,iblock(*),indexw(*),isplit(*)
integer(${ik}$), intent(out) :: info,isuppz(*),iwork(*)
real(dp), intent(in) :: minrgp,pivmin,vl,vu,gers(*)
real(dp), intent(inout) :: rtol1,rtol2,d(*),l(*),w(*),werr(*),wgap(*)
real(dp), intent(out) :: work(*)
complex(dp), intent(out) :: z(ldz,*)
end subroutine zlarrv
#else
module procedure stdlib${ii}$_zlarrv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larrv
#:endif
#:endfor
#:endfor
end interface larrv
interface lartg
!! LARTG generates a plane rotation so that
!! [ C S ] . [ F ] = [ R ]
!! [ -conjg(S) C ] [ G ] [ 0 ]
!! where C is real and C**2 + |S|**2 = 1.
!! The mathematical formulas used for C and S are
!! sgn(x) = { x / |x|, x != 0
!! { 1, x = 0
!! R = sgn(F) * sqrt(|F|**2 + |G|**2)
!! C = |F| / sqrt(|F|**2 + |G|**2)
!! S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2)
!! When F and G are real, the formulas simplify to C = F/R and
!! S = G/R, and the returned values of C, S, and R should be
!! identical to those returned by LARTG.
!! The algorithm used to compute these quantities incorporates scaling
!! to avoid overflow or underflow in computing the square root of the
!! sum of squares.
!! This is a faster version of the BLAS1 routine CROTG, except for
!! the following differences:
!! F and G are unchanged on return.
!! If G=0, then C=1 and S=0.
!! If F=0, then C=0 and S is chosen so that R is real.
!! Below, wp=>sp stands for single precision from LA_CONSTANTS module.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#:for rk,rt,ri in RC_KINDS_TYPES
#:if rk in ["sp","dp"]
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine ${ri}$lartg( f, g, c, s, r )
import sp,dp,qp,${ik}$,lk
implicit none
real(${rk}$), intent(out) :: c
${rt}$, intent(in) :: f,g
${rt}$, intent(out) :: r,s
end subroutine ${ri}$lartg
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_${ri}$lartg
#:endif
#endif
#:elif not 'ilp64' in ik
module procedure stdlib${ii}$_${ri}$lartg
#:endif
#:endfor
#:endfor
end interface lartg
interface lartgp
!! LARTGP generates a plane rotation so that
!! [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
!! [ -SN CS ] [ G ] [ 0 ]
!! This is a slower, more accurate version of the Level 1 BLAS routine DROTG,
!! with the following other differences:
!! F and G are unchanged on return.
!! If G=0, then CS=(+/-)1 and SN=0.
!! If F=0 and (G .ne. 0), then CS=0 and SN=(+/-)1.
!! The sign is chosen so that R >= 0.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if rk in ["sp","dp"]
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine ${ri}$lartgp( f, g, cs, sn, r )
import sp,dp,qp,${ik}$,lk
implicit none
${rt}$, intent(out) :: cs,r,sn
${rt}$, intent(in) :: f,g
end subroutine ${ri}$lartgp
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_${ri}$lartgp
#:endif
#endif
#:elif not 'ilp64' in ik
module procedure stdlib${ii}$_${ri}$lartgp
#:endif
#:endfor
#:endfor
end interface lartgp
interface lartgs
!! LARTGS generates a plane rotation designed to introduce a bulge in
!! Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD
!! problem. X and Y are the top-row entries, and SIGMA is the shift.
!! The computed CS and SN define a plane rotation satisfying
!! [ CS SN ] . [ X^2 - SIGMA ] = [ R ],
!! [ -SN CS ] [ X * Y ] [ 0 ]
!! with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the
!! rotation is by PI/2.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if rk in ["sp","dp"]
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine ${ri}$lartgs( x, y, sigma, cs, sn )
import sp,dp,qp,${ik}$,lk
implicit none
${rt}$, intent(out) :: cs,sn
${rt}$, intent(in) :: sigma,x,y
end subroutine ${ri}$lartgs
#:if not 'ilp64' in ik
#else
module procedure stdlib${ii}$_${ri}$lartgs
#:endif
#endif
#:elif not 'ilp64' in ik
module procedure stdlib${ii}$_${ri}$lartgs
#:endif
#:endfor
#:endfor
end interface lartgs
interface lartv
!! LARTV applies a vector of complex plane rotations with real cosines
!! to elements of the complex vectors x and y. For i = 1,2,...,n
!! ( x(i) ) := ( c(i) s(i) ) ( x(i) )
!! ( y(i) ) ( -conjg(s(i)) c(i) ) ( y(i) )
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clartv( n, x, incx, y, incy, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(sp), intent(in) :: c(*)
complex(sp), intent(in) :: s(*)
complex(sp), intent(inout) :: x(*),y(*)
end subroutine clartv
#else
module procedure stdlib${ii}$_clartv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlartv( n, x, incx, y, incy, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(dp), intent(in) :: c(*),s(*)
real(dp), intent(inout) :: x(*),y(*)
end subroutine dlartv
#else
module procedure stdlib${ii}$_dlartv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slartv( n, x, incx, y, incy, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(sp), intent(in) :: c(*),s(*)
real(sp), intent(inout) :: x(*),y(*)
end subroutine slartv
#else
module procedure stdlib${ii}$_slartv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlartv( n, x, incx, y, incy, c, s, incc )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incc,incx,incy,n
real(dp), intent(in) :: c(*)
complex(dp), intent(in) :: s(*)
complex(dp), intent(inout) :: x(*),y(*)
end subroutine zlartv
#else
module procedure stdlib${ii}$_zlartv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lartv
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lartv
#:endif
#:endfor
#:endfor
end interface lartv
interface laruv
!! LARUV returns a vector of n random real numbers from a uniform (0,1)
!! distribution (n <= 128).
!! This is an auxiliary routine called by DLARNV and ZLARNV.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaruv( iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
integer(${ik}$), intent(inout) :: iseed(4)
real(dp), intent(out) :: x(n)
end subroutine dlaruv
#else
module procedure stdlib${ii}$_dlaruv
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaruv( iseed, n, x )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: n
integer(${ik}$), intent(inout) :: iseed(4)
real(sp), intent(out) :: x(n)
end subroutine slaruv
#else
module procedure stdlib${ii}$_slaruv
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laruv
#:endif
#:endfor
#:endfor
end interface laruv
interface larz
!! LARZ applies a complex elementary reflector H to a complex
!! M-by-N matrix C, from either the left or the right. H is represented
!! in the form
!! H = I - tau * v * v**H
!! where tau is a complex scalar and v is a complex vector.
!! If tau = 0, then H is taken to be the unit matrix.
!! To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
!! tau.
!! H is a product of k elementary reflectors as returned by CTZRZF.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarz( side, m, n, l, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,l,ldc,m,n
complex(sp), intent(in) :: tau,v(*)
complex(sp), intent(inout) :: c(ldc,*)
complex(sp), intent(out) :: work(*)
end subroutine clarz
#else
module procedure stdlib${ii}$_clarz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarz( side, m, n, l, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,l,ldc,m,n
real(dp), intent(in) :: tau,v(*)
real(dp), intent(inout) :: c(ldc,*)
real(dp), intent(out) :: work(*)
end subroutine dlarz
#else
module procedure stdlib${ii}$_dlarz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarz( side, m, n, l, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,l,ldc,m,n
real(sp), intent(in) :: tau,v(*)
real(sp), intent(inout) :: c(ldc,*)
real(sp), intent(out) :: work(*)
end subroutine slarz
#else
module procedure stdlib${ii}$_slarz
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarz( side, m, n, l, v, incv, tau, c, ldc, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: side
integer(${ik}$), intent(in) :: incv,l,ldc,m,n
complex(dp), intent(in) :: tau,v(*)
complex(dp), intent(inout) :: c(ldc,*)
complex(dp), intent(out) :: work(*)
end subroutine zlarz
#else
module procedure stdlib${ii}$_zlarz
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larz
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larz
#:endif
#:endfor
#:endfor
end interface larz
interface larzb
!! LARZB applies a complex block reflector H or its transpose H**H
!! to a complex distributed M-by-N C from the left or the right.
!! Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,l,ldc,ldt,ldv,ldwork,m,n
complex(sp), intent(inout) :: c(ldc,*),t(ldt,*),v(ldv,*)
complex(sp), intent(out) :: work(ldwork,*)
end subroutine clarzb
#else
module procedure stdlib${ii}$_clarzb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,l,ldc,ldt,ldv,ldwork,m,n
real(dp), intent(inout) :: c(ldc,*),t(ldt,*),v(ldv,*)
real(dp), intent(out) :: work(ldwork,*)
end subroutine dlarzb
#else
module procedure stdlib${ii}$_dlarzb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,l,ldc,ldt,ldv,ldwork,m,n
real(sp), intent(inout) :: c(ldc,*),t(ldt,*),v(ldv,*)
real(sp), intent(out) :: work(ldwork,*)
end subroutine slarzb
#else
module procedure stdlib${ii}$_slarzb
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, &
ldc, work, ldwork )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,side,storev,trans
integer(${ik}$), intent(in) :: k,l,ldc,ldt,ldv,ldwork,m,n
complex(dp), intent(inout) :: c(ldc,*),t(ldt,*),v(ldv,*)
complex(dp), intent(out) :: work(ldwork,*)
end subroutine zlarzb
#else
module procedure stdlib${ii}$_zlarzb
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larzb
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larzb
#:endif
#:endfor
#:endfor
end interface larzb
interface larzt
!! LARZT forms the triangular factor T of a complex block reflector
!! H of order > n, which is defined as a product of k elementary
!! reflectors.
!! If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
!! If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
!! If STOREV = 'C', the vector which defines the elementary reflector
!! H(i) is stored in the i-th column of the array V, and
!! H = I - V * T * V**H
!! If STOREV = 'R', the vector which defines the elementary reflector
!! H(i) is stored in the i-th row of the array V, and
!! H = I - V**H * T * V
!! Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clarzt( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
complex(sp), intent(out) :: t(ldt,*)
complex(sp), intent(in) :: tau(*)
complex(sp), intent(inout) :: v(ldv,*)
end subroutine clarzt
#else
module procedure stdlib${ii}$_clarzt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlarzt( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
real(dp), intent(out) :: t(ldt,*)
real(dp), intent(in) :: tau(*)
real(dp), intent(inout) :: v(ldv,*)
end subroutine dlarzt
#else
module procedure stdlib${ii}$_dlarzt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slarzt( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
real(sp), intent(out) :: t(ldt,*)
real(sp), intent(in) :: tau(*)
real(sp), intent(inout) :: v(ldv,*)
end subroutine slarzt
#else
module procedure stdlib${ii}$_slarzt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlarzt( direct, storev, n, k, v, ldv, tau, t, ldt )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,storev
integer(${ik}$), intent(in) :: k,ldt,ldv,n
complex(dp), intent(out) :: t(ldt,*)
complex(dp), intent(in) :: tau(*)
complex(dp), intent(inout) :: v(ldv,*)
end subroutine zlarzt
#else
module procedure stdlib${ii}$_zlarzt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larzt
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$larzt
#:endif
#:endfor
#:endfor
end interface larzt
interface lascl
!! LASCL multiplies the M by N complex matrix A by the real scalar
!! CTO/CFROM. This is done without over/underflow as long as the final
!! result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
!! A may be full, upper triangular, lower triangular, upper Hessenberg,
!! or banded.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: type
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,lda,m,n
real(sp), intent(in) :: cfrom,cto
complex(sp), intent(inout) :: a(lda,*)
end subroutine clascl
#else
module procedure stdlib${ii}$_clascl
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: type
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,lda,m,n
real(dp), intent(in) :: cfrom,cto
real(dp), intent(inout) :: a(lda,*)
end subroutine dlascl
#else
module procedure stdlib${ii}$_dlascl
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slascl( type, kl, ku, cfrom, cto, m, n, a, lda, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: type
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,lda,m,n
real(sp), intent(in) :: cfrom,cto
real(sp), intent(inout) :: a(lda,*)
end subroutine slascl
#else
module procedure stdlib${ii}$_slascl
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: type
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kl,ku,lda,m,n
real(dp), intent(in) :: cfrom,cto
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlascl
#else
module procedure stdlib${ii}$_zlascl
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lascl
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lascl
#:endif
#:endfor
#:endfor
end interface lascl
interface lasd0
!! Using a divide and conquer approach, LASD0: computes the singular
!! value decomposition (SVD) of a real upper bidiagonal N-by-M
!! matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
!! The algorithm computes orthogonal matrices U and VT such that
!! B = U * S * VT. The singular values S are overwritten on D.
!! A related subroutine, DLASDA, computes only the singular values,
!! and optionally, the singular vectors in compact form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,n,smlsiz,sqre
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine dlasd0
#else
module procedure stdlib${ii}$_dlasd0
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,n,smlsiz,sqre
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: u(ldu,*),vt(ldvt,*),work(*)
end subroutine slasd0
#else
module procedure stdlib${ii}$_slasd0
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd0
#:endif
#:endfor
#:endfor
end interface lasd0
interface lasd1
!! LASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
!! where N = NL + NR + 1 and M = N + SQRE. LASD1 is called from DLASD0.
!! A related subroutine DLASD7 handles the case in which the singular
!! values (and the singular vectors in factored form) are desired.
!! LASD1 computes the SVD as follows:
!! ( D1(in) 0 0 0 )
!! B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
!! ( 0 0 D2(in) 0 )
!! = U(out) * ( D(out) 0) * VT(out)
!! where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
!! with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
!! elsewhere; and the entry b is empty if SQRE = 0.
!! The left singular vectors of the original matrix are stored in U, and
!! the transpose of the right singular vectors are stored in VT, and the
!! singular values are in D. The algorithm consists of three stages:
!! The first stage consists of deflating the size of the problem
!! when there are multiple singular values or when there are zeros in
!! the Z vector. For each such occurrence the dimension of the
!! secular equation problem is reduced by one. This stage is
!! performed by the routine DLASD2.
!! The second stage consists of calculating the updated
!! singular values. This is done by finding the square roots of the
!! roots of the secular equation via the routine DLASD4 (as called
!! by DLASD3). This routine also calculates the singular vectors of
!! the current problem.
!! The final stage consists of computing the updated singular vectors
!! directly using the updated singular values. The singular vectors
!! for the current problem are multiplied with the singular vectors
!! from the overall problem.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork,&
work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,nl,nr,sqre
real(dp), intent(inout) :: alpha,beta,d(*),u(ldu,*),vt(ldvt,*)
integer(${ik}$), intent(inout) :: idxq(*)
real(dp), intent(out) :: work(*)
end subroutine dlasd1
#else
module procedure stdlib${ii}$_dlasd1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork,&
work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info,iwork(*)
integer(${ik}$), intent(in) :: ldu,ldvt,nl,nr,sqre
real(sp), intent(inout) :: alpha,beta,d(*),u(ldu,*),vt(ldvt,*)
integer(${ik}$), intent(inout) :: idxq(*)
real(sp), intent(out) :: work(*)
end subroutine slasd1
#else
module procedure stdlib${ii}$_slasd1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd1
#:endif
#:endfor
#:endfor
end interface lasd1
interface lasd4
!! This subroutine computes the square root of the I-th updated
!! eigenvalue of a positive symmetric rank-one modification to
!! a positive diagonal matrix whose entries are given as the squares
!! of the corresponding entries in the array d, and that
!! 0 <= D(i) < D(j) for i < j
!! and that RHO > 0. This is arranged by the calling routine, and is
!! no loss in generality. The rank-one modified system is thus
!! diag( D ) * diag( D ) + RHO * Z * Z_transpose.
!! where we assume the Euclidean norm of Z is 1.
!! The method consists of approximating the rational functions in the
!! secular equation by simpler interpolating rational functions.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd4( n, i, d, z, delta, rho, sigma, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i,n
integer(${ik}$), intent(out) :: info
real(dp), intent(in) :: rho,d(*),z(*)
real(dp), intent(out) :: sigma,delta(*),work(*)
end subroutine dlasd4
#else
module procedure stdlib${ii}$_dlasd4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd4( n, i, d, z, delta, rho, sigma, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i,n
integer(${ik}$), intent(out) :: info
real(sp), intent(in) :: rho,d(*),z(*)
real(sp), intent(out) :: sigma,delta(*),work(*)
end subroutine slasd4
#else
module procedure stdlib${ii}$_slasd4
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd4
#:endif
#:endfor
#:endfor
end interface lasd4
interface lasd5
!! This subroutine computes the square root of the I-th eigenvalue
!! of a positive symmetric rank-one modification of a 2-by-2 diagonal
!! matrix
!! diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
!! The diagonal entries in the array D are assumed to satisfy
!! 0 <= D(i) < D(j) for i < j .
!! We also assume RHO > 0 and that the Euclidean norm of the vector
!! Z is one.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd5( i, d, z, delta, rho, dsigma, work )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i
real(dp), intent(out) :: dsigma,delta(2),work(2)
real(dp), intent(in) :: rho,d(2),z(2)
end subroutine dlasd5
#else
module procedure stdlib${ii}$_dlasd5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd5( i, d, z, delta, rho, dsigma, work )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i
real(sp), intent(out) :: dsigma,delta(2),work(2)
real(sp), intent(in) :: rho,d(2),z(2)
end subroutine slasd5
#else
module procedure stdlib${ii}$_slasd5
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd5
#:endif
#:endfor
#:endfor
end interface lasd5
interface lasd6
!! LASD6 computes the SVD of an updated upper bidiagonal matrix B
!! obtained by merging two smaller ones by appending a row. This
!! routine is used only for the problem which requires all singular
!! values and optionally singular vector matrices in factored form.
!! B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
!! A related subroutine, DLASD1, handles the case in which all singular
!! values and singular vectors of the bidiagonal matrix are desired.
!! LASD6 computes the SVD as follows:
!! ( D1(in) 0 0 0 )
!! B = U(in) * ( Z1**T a Z2**T b ) * VT(in)
!! ( 0 0 D2(in) 0 )
!! = U(out) * ( D(out) 0) * VT(out)
!! where Z**T = (Z1**T a Z2**T b) = u**T VT**T, and u is a vector of dimension M
!! with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
!! elsewhere; and the entry b is empty if SQRE = 0.
!! The singular values of B can be computed using D1, D2, the first
!! components of all the right singular vectors of the lower block, and
!! the last components of all the right singular vectors of the upper
!! block. These components are stored and updated in VF and VL,
!! respectively, in LASD6. Hence U and VT are not explicitly
!! referenced.
!! The singular values are stored in D. The algorithm consists of two
!! stages:
!! The first stage consists of deflating the size of the problem
!! when there are multiple singular values or if there is a zero
!! in the Z vector. For each such occurrence the dimension of the
!! secular equation problem is reduced by one. This stage is
!! performed by the routine DLASD7.
!! The second stage consists of calculating the updated
!! singular values. This is done by finding the roots of the
!! secular equation via the routine DLASD4 (as called by DLASD8).
!! This routine also updates VF and VL and computes the distances
!! between the updated singular values and the old singular
!! values.
!! LASD6 is called from DLASDA.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, &
givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: givptr,info,k,givcol(ldgcol,*),iwork(*),perm(*)
integer(${ik}$), intent(in) :: icompq,ldgcol,ldgnum,nl,nr,sqre
real(dp), intent(inout) :: alpha,beta,d(*),vf(*),vl(*)
real(dp), intent(out) :: c,s,difl(*),difr(*),givnum(ldgnum,*),poles(ldgnum,*),&
work(*),z(*)
integer(${ik}$), intent(inout) :: idxq(*)
end subroutine dlasd6
#else
module procedure stdlib${ii}$_dlasd6
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, &
givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: givptr,info,k,givcol(ldgcol,*),iwork(*),perm(*)
integer(${ik}$), intent(in) :: icompq,ldgcol,ldgnum,nl,nr,sqre
real(sp), intent(inout) :: alpha,beta,d(*),vf(*),vl(*)
real(sp), intent(out) :: c,s,difl(*),difr(*),givnum(ldgnum,*),poles(ldgnum,*),&
work(*),z(*)
integer(${ik}$), intent(inout) :: idxq(*)
end subroutine slasd6
#else
module procedure stdlib${ii}$_slasd6
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd6
#:endif
#:endfor
#:endfor
end interface lasd6
interface lasd7
!! LASD7 merges the two sets of singular values together into a single
!! sorted set. Then it tries to deflate the size of the problem. There
!! are two ways in which deflation can occur: when two or more singular
!! values are close together or if there is a tiny entry in the Z
!! vector. For each such occurrence the order of the related
!! secular equation problem is reduced by one.
!! LASD7 is called from DLASD6.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, &
beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: givptr,info,k,givcol(ldgcol,*),idx(*),idxp(*),&
perm(*)
integer(${ik}$), intent(in) :: icompq,ldgcol,ldgnum,nl,nr,sqre
real(dp), intent(in) :: alpha,beta
real(dp), intent(out) :: c,s,dsigma(*),givnum(ldgnum,*),vfw(*),vlw(*),z(*),zw(&
*)
integer(${ik}$), intent(inout) :: idxq(*)
real(dp), intent(inout) :: d(*),vf(*),vl(*)
end subroutine dlasd7
#else
module procedure stdlib${ii}$_dlasd7
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, &
beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: givptr,info,k,givcol(ldgcol,*),idx(*),idxp(*),&
perm(*)
integer(${ik}$), intent(in) :: icompq,ldgcol,ldgnum,nl,nr,sqre
real(sp), intent(in) :: alpha,beta
real(sp), intent(out) :: c,s,dsigma(*),givnum(ldgnum,*),vfw(*),vlw(*),z(*),zw(&
*)
integer(${ik}$), intent(inout) :: idxq(*)
real(sp), intent(inout) :: d(*),vf(*),vl(*)
end subroutine slasd7
#else
module procedure stdlib${ii}$_slasd7
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd7
#:endif
#:endfor
#:endfor
end interface lasd7
interface lasd8
!! LASD8 finds the square roots of the roots of the secular equation,
!! as defined by the values in DSIGMA and Z. It makes the appropriate
!! calls to DLASD4, and stores, for each element in D, the distance
!! to its two nearest poles (elements in DSIGMA). It also updates
!! the arrays VF and VL, the first and last components of all the
!! right singular vectors of the original bidiagonal matrix.
!! LASD8 is called from DLASD6.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,k,lddifr
integer(${ik}$), intent(out) :: info
real(dp), intent(out) :: d(*),difl(*),difr(lddifr,*),work(*)
real(dp), intent(inout) :: dsigma(*),vf(*),vl(*),z(*)
end subroutine dlasd8
#else
module procedure stdlib${ii}$_dlasd8
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, &
info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,k,lddifr
integer(${ik}$), intent(out) :: info
real(sp), intent(out) :: d(*),difl(*),difr(lddifr,*),work(*)
real(sp), intent(inout) :: dsigma(*),vf(*),vl(*),z(*)
end subroutine slasd8
#else
module procedure stdlib${ii}$_slasd8
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasd8
#:endif
#:endfor
#:endfor
end interface lasd8
interface lasda
!! Using a divide and conquer approach, LASDA: computes the singular
!! value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
!! B with diagonal D and offdiagonal E, where M = N + SQRE. The
!! algorithm computes the singular values in the SVD B = U * S * VT.
!! The orthogonal matrices U and VT are optionally computed in
!! compact form.
!! A related subroutine, DLASD0, computes the singular values and
!! the singular vectors in explicit form.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z,&
poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldgcol,ldu,n,smlsiz,sqre
integer(${ik}$), intent(out) :: info,givcol(ldgcol,*),givptr(*),iwork(*),k(*),&
perm(ldgcol,*)
real(dp), intent(out) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),work(*),z(ldu,*)
real(dp), intent(inout) :: d(*),e(*)
end subroutine dlasda
#else
module procedure stdlib${ii}$_dlasda
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z,&
poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: icompq,ldgcol,ldu,n,smlsiz,sqre
integer(${ik}$), intent(out) :: info,givcol(ldgcol,*),givptr(*),iwork(*),k(*),&
perm(ldgcol,*)
real(sp), intent(out) :: c(*),difl(ldu,*),difr(ldu,*),givnum(ldu,*),poles(ldu,&
*),s(*),u(ldu,*),vt(ldu,*),work(*),z(ldu,*)
real(sp), intent(inout) :: d(*),e(*)
end subroutine slasda
#else
module procedure stdlib${ii}$_slasda
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasda
#:endif
#:endfor
#:endfor
end interface lasda
interface lasdq
!! LASDQ computes the singular value decomposition (SVD) of a real
!! (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
!! E, accumulating the transformations if desired. Letting B denote
!! the input bidiagonal matrix, the algorithm computes orthogonal
!! matrices Q and P such that B = Q * S * P**T (P**T denotes the transpose
!! of P). The singular values S are overwritten on D.
!! The input matrix U is changed to U * Q if desired.
!! The input matrix VT is changed to P**T * VT if desired.
!! The input matrix C is changed to Q**T * C if desired.
!! See "Computing Small Singular Values of Bidiagonal Matrices With
!! Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
!! LAPACK Working Note #3, for a detailed description of the algorithm.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, &
ldc, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru,sqre
real(dp), intent(inout) :: c(ldc,*),d(*),e(*),u(ldu,*),vt(ldvt,*)
real(dp), intent(out) :: work(*)
end subroutine dlasdq
#else
module procedure stdlib${ii}$_dlasdq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, &
ldc, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: ldc,ldu,ldvt,n,ncc,ncvt,nru,sqre
real(sp), intent(inout) :: c(ldc,*),d(*),e(*),u(ldu,*),vt(ldvt,*)
real(sp), intent(out) :: work(*)
end subroutine slasdq
#else
module procedure stdlib${ii}$_slasdq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasdq
#:endif
#:endfor
#:endfor
end interface lasdq
interface laset
!! LASET initializes a 2-D array A to BETA on the diagonal and
!! ALPHA on the offdiagonals.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claset( uplo, m, n, alpha, beta, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,m,n
complex(sp), intent(in) :: alpha,beta
complex(sp), intent(out) :: a(lda,*)
end subroutine claset
#else
module procedure stdlib${ii}$_claset
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaset( uplo, m, n, alpha, beta, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: alpha,beta
real(dp), intent(out) :: a(lda,*)
end subroutine dlaset
#else
module procedure stdlib${ii}$_dlaset
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaset( uplo, m, n, alpha, beta, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: alpha,beta
real(sp), intent(out) :: a(lda,*)
end subroutine slaset
#else
module procedure stdlib${ii}$_slaset
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaset( uplo, m, n, alpha, beta, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: lda,m,n
complex(dp), intent(in) :: alpha,beta
complex(dp), intent(out) :: a(lda,*)
end subroutine zlaset
#else
module procedure stdlib${ii}$_zlaset
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laset
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laset
#:endif
#:endfor
#:endfor
end interface laset
interface lasq1
!! LASQ1 computes the singular values of a real N-by-N bidiagonal
!! matrix with diagonal D and off-diagonal E. The singular values
!! are computed to high relative accuracy, in the absence of
!! denormalization, underflow and overflow. The algorithm was first
!! presented in
!! "Accurate singular values and differential qd algorithms" by K. V.
!! Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
!! 1994,
!! and the present implementation is described in "An implementation of
!! the dqds Algorithm (Positive Case)", LAPACK Working Note.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasq1( n, d, e, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: d(*),e(*)
real(dp), intent(out) :: work(*)
end subroutine dlasq1
#else
module procedure stdlib${ii}$_dlasq1
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasq1( n, d, e, work, info )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: d(*),e(*)
real(sp), intent(out) :: work(*)
end subroutine slasq1
#else
module procedure stdlib${ii}$_slasq1
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasq1
#:endif
#:endfor
#:endfor
end interface lasq1
interface lasq4
!! LASQ4 computes an approximation TAU to the smallest eigenvalue
!! using values of d from the previous transform.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, &
ttype, g )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i0,n0,n0in,pp
integer(${ik}$), intent(out) :: ttype
real(dp), intent(in) :: dmin,dmin1,dmin2,dn,dn1,dn2,z(*)
real(dp), intent(inout) :: g
real(dp), intent(out) :: tau
end subroutine dlasq4
#else
module procedure stdlib${ii}$_dlasq4
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, &
ttype, g )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i0,n0,n0in,pp
integer(${ik}$), intent(out) :: ttype
real(sp), intent(in) :: dmin,dmin1,dmin2,dn,dn1,dn2,z(*)
real(sp), intent(inout) :: g
real(sp), intent(out) :: tau
end subroutine slasq4
#else
module procedure stdlib${ii}$_slasq4
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasq4
#:endif
#:endfor
#:endfor
end interface lasq4
interface lasq5
!! LASQ5 computes one dqds transform in ping-pong form, one
!! version for IEEE machines another for non IEEE machines.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, &
dnm2, ieee, eps )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ieee
integer(${ik}$), intent(in) :: i0,n0,pp
real(dp), intent(out) :: dmin,dmin1,dmin2,dn,dnm1,dnm2
real(dp), intent(inout) :: tau,z(*)
real(dp), intent(in) :: sigma,eps
end subroutine dlasq5
#else
module procedure stdlib${ii}$_dlasq5
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, &
dnm2, ieee, eps )
import sp,dp,qp,${ik}$,lk
implicit none
logical(lk), intent(in) :: ieee
integer(${ik}$), intent(in) :: i0,n0,pp
real(sp), intent(out) :: dmin,dmin1,dmin2,dn,dnm1,dnm2
real(sp), intent(inout) :: tau,z(*)
real(sp), intent(in) :: sigma,eps
end subroutine slasq5
#else
module procedure stdlib${ii}$_slasq5
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasq5
#:endif
#:endfor
#:endfor
end interface lasq5
interface lasq6
!! LASQ6 computes one dqd (shift equal to zero) transform in
!! ping-pong form, with protection against underflow and overflow.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i0,n0,pp
real(dp), intent(out) :: dmin,dmin1,dmin2,dn,dnm1,dnm2
real(dp), intent(inout) :: z(*)
end subroutine dlasq6
#else
module procedure stdlib${ii}$_dlasq6
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: i0,n0,pp
real(sp), intent(out) :: dmin,dmin1,dmin2,dn,dnm1,dnm2
real(sp), intent(inout) :: z(*)
end subroutine slasq6
#else
module procedure stdlib${ii}$_slasq6
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasq6
#:endif
#:endfor
#:endfor
end interface lasq6
interface lasr
!! LASR applies a sequence of real plane rotations to a complex matrix
!! A, from either the left or the right.
!! When SIDE = 'L', the transformation takes the form
!! A := P*A
!! and when SIDE = 'R', the transformation takes the form
!! A := A*P**T
!! where P is an orthogonal matrix consisting of a sequence of z plane
!! rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
!! and P**T is the transpose of P.
!! When DIRECT = 'F' (Forward sequence), then
!! P = P(z-1) * ... * P(2) * P(1)
!! and when DIRECT = 'B' (Backward sequence), then
!! P = P(1) * P(2) * ... * P(z-1)
!! where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
!! R(k) = ( c(k) s(k) )
!! = ( -s(k) c(k) ).
!! When PIVOT = 'V' (Variable pivot), the rotation is performed
!! for the plane (k,k+1), i.e., P(k) has the form
!! P(k) = ( 1 )
!! ( ... )
!! ( 1 )
!! ( c(k) s(k) )
!! ( -s(k) c(k) )
!! ( 1 )
!! ( ... )
!! ( 1 )
!! where R(k) appears as a rank-2 modification to the identity matrix in
!! rows and columns k and k+1.
!! When PIVOT = 'T' (Top pivot), the rotation is performed for the
!! plane (1,k+1), so P(k) has the form
!! P(k) = ( c(k) s(k) )
!! ( 1 )
!! ( ... )
!! ( 1 )
!! ( -s(k) c(k) )
!! ( 1 )
!! ( ... )
!! ( 1 )
!! where R(k) appears in rows and columns 1 and k+1.
!! Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
!! performed for the plane (k,z), giving P(k) the form
!! P(k) = ( 1 )
!! ( ... )
!! ( 1 )
!! ( c(k) s(k) )
!! ( 1 )
!! ( ... )
!! ( 1 )
!! ( -s(k) c(k) )
!! where R(k) appears in rows and columns k and z. The rotations are
!! performed without ever forming P(k) explicitly.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clasr( side, pivot, direct, m, n, c, s, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,pivot,side
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(in) :: c(*),s(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine clasr
#else
module procedure stdlib${ii}$_clasr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasr( side, pivot, direct, m, n, c, s, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,pivot,side
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(in) :: c(*),s(*)
end subroutine dlasr
#else
module procedure stdlib${ii}$_dlasr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasr( side, pivot, direct, m, n, c, s, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,pivot,side
integer(${ik}$), intent(in) :: lda,m,n
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(in) :: c(*),s(*)
end subroutine slasr
#else
module procedure stdlib${ii}$_slasr
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlasr( side, pivot, direct, m, n, c, s, a, lda )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: direct,pivot,side
integer(${ik}$), intent(in) :: lda,m,n
real(dp), intent(in) :: c(*),s(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlasr
#else
module procedure stdlib${ii}$_zlasr
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasr
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasr
#:endif
#:endfor
#:endfor
end interface lasr
interface lasrt
!! Sort the numbers in D in increasing order (if ID = 'I') or
!! in decreasing order (if ID = 'D' ).
!! Use Quick Sort, reverting to Insertion sort on arrays of
!! size <= 20. Dimension of STACK limits N to about 2**32.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasrt( id, n, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: id
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(dp), intent(inout) :: d(*)
end subroutine dlasrt
#else
module procedure stdlib${ii}$_dlasrt
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasrt( id, n, d, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: id
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(sp), intent(inout) :: d(*)
end subroutine slasrt
#else
module procedure stdlib${ii}$_slasrt
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasrt
#:endif
#:endfor
#:endfor
end interface lasrt
interface lassq
!! LASSQ returns the values scl and smsq such that
!! ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
!! where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
!! assumed to be non-negative.
!! scale and sumsq must be supplied in SCALE and SUMSQ and
!! scl and smsq are overwritten on SCALE and SUMSQ respectively.
!! If scale * sqrt( sumsq ) > tbig then
!! we require: scale >= sqrt( TINY*EPS ) / sbig on entry,
!! and if 0 < scale * sqrt( sumsq ) < tsml then
!! we require: scale <= sqrt( HUGE ) / ssml on entry,
!! where
!! tbig -- upper threshold for values whose square is representable;
!! sbig -- scaling constant for big numbers; \see la_constants.f90
!! tsml -- lower threshold for values whose square is representable;
!! ssml -- scaling constant for small numbers; \see la_constants.f90
!! and
!! TINY*EPS -- tiniest representable number;
!! HUGE -- biggest representable number.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine classq( n, x, incx, scl, sumsq )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(inout) :: scl,sumsq
complex(sp), intent(in) :: x(*)
end subroutine classq
#else
module procedure stdlib${ii}$_classq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlassq( n, x, incx, scl, sumsq )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(inout) :: scl,sumsq
real(dp), intent(in) :: x(*)
end subroutine dlassq
#else
module procedure stdlib${ii}$_dlassq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slassq( n, x, incx, scl, sumsq )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(sp), intent(inout) :: scl,sumsq
real(sp), intent(in) :: x(*)
end subroutine slassq
#else
module procedure stdlib${ii}$_slassq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlassq( n, x, incx, scl, sumsq )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,n
real(dp), intent(inout) :: scl,sumsq
complex(dp), intent(in) :: x(*)
end subroutine zlassq
#else
module procedure stdlib${ii}$_zlassq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lassq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lassq
#:endif
#:endfor
#:endfor
end interface lassq
interface laswlq
!! LASWLQ computes a blocked Tall-Skinny LQ factorization of
!! a complex M-by-N matrix A for M <= N:
!! A = ( L 0 ) * Q,
!! where:
!! Q is a n-by-N orthogonal matrix, stored on exit in an implicit
!! form in the elements above the diagonal of the array A and in
!! the elements of the array T;
!! L is a lower-triangular M-by-M matrix stored on exit in
!! the elements on and below the diagonal of the array A.
!! 0 is a M-by-(N-M) zero matrix, if M < N, and is not stored.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,mb,nb,lwork,ldt
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: work(*),t(ldt,*)
end subroutine claswlq
#else
module procedure stdlib${ii}$_claswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,mb,nb,lwork,ldt
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: work(*),t(ldt,*)
end subroutine dlaswlq
#else
module procedure stdlib${ii}$_dlaswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,mb,nb,lwork,ldt
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: work(*),t(ldt,*)
end subroutine slaswlq
#else
module procedure stdlib${ii}$_slaswlq
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info)
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: lda,m,n,mb,nb,lwork,ldt
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: work(*),t(ldt,*)
end subroutine zlaswlq
#else
module procedure stdlib${ii}$_zlaswlq
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laswlq
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laswlq
#:endif
#:endfor
#:endfor
end interface laswlq
interface laswp
!! LASWP performs a series of row interchanges on the matrix A.
!! One row interchange is initiated for each of rows K1 through K2 of A.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine claswp( n, a, lda, k1, k2, ipiv, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,k1,k2,lda,n,ipiv(*)
complex(sp), intent(inout) :: a(lda,*)
end subroutine claswp
#else
module procedure stdlib${ii}$_claswp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlaswp( n, a, lda, k1, k2, ipiv, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,k1,k2,lda,n,ipiv(*)
real(dp), intent(inout) :: a(lda,*)
end subroutine dlaswp
#else
module procedure stdlib${ii}$_dlaswp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slaswp( n, a, lda, k1, k2, ipiv, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,k1,k2,lda,n,ipiv(*)
real(sp), intent(inout) :: a(lda,*)
end subroutine slaswp
#else
module procedure stdlib${ii}$_slaswp
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlaswp( n, a, lda, k1, k2, ipiv, incx )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: incx,k1,k2,lda,n,ipiv(*)
complex(dp), intent(inout) :: a(lda,*)
end subroutine zlaswp
#else
module procedure stdlib${ii}$_zlaswp
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laswp
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$laswp
#:endif
#:endfor
#:endfor
end interface laswp
interface lasyf
!! LASYF computes a partial factorization of a complex symmetric matrix
!! A using the Bunch-Kaufman diagonal pivoting method. The partial
!! factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**T U22**T )
!! A = ( L11 0 ) ( D 0 ) ( L11**T L21**T ) if UPLO = 'L'
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! Note that U**T denotes the transpose of U.
!! LASYF is an auxiliary routine called by CSYTRF. It uses blocked code
!! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
!! A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: w(ldw,*)
end subroutine clasyf
#else
module procedure stdlib${ii}$_clasyf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: w(ldw,*)
end subroutine dlasyf
#else
module procedure stdlib${ii}$_dlasyf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: w(ldw,*)
end subroutine slasyf
#else
module procedure stdlib${ii}$_slasyf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: w(ldw,*)
end subroutine zlasyf
#else
module procedure stdlib${ii}$_zlasyf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf
#:endif
#:endfor
#:endfor
end interface lasyf
interface lasyf_aa
!! DLATRF_AA factorizes a panel of a complex symmetric matrix A using
!! the Aasen's algorithm. The panel consists of a set of NB rows of A
!! when UPLO is U, or a set of NB columns when UPLO is L.
!! In order to factorize the panel, the Aasen's algorithm requires the
!! last row, or column, of the previous panel. The first row, or column,
!! of A is set to be the first row, or column, of an identity matrix,
!! which is used to factorize the first panel.
!! The resulting J-th row of U, or J-th column of L, is stored in the
!! (J-1)-th row, or column, of A (without the unit diagonals), while
!! the diagonal and subdiagonal of A are overwritten by those of T.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
complex(sp), intent(inout) :: a(lda,*),h(ldh,*)
complex(sp), intent(out) :: work(*)
end subroutine clasyf_aa
#else
module procedure stdlib${ii}$_clasyf_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
real(dp), intent(inout) :: a(lda,*),h(ldh,*)
real(dp), intent(out) :: work(*)
end subroutine dlasyf_aa
#else
module procedure stdlib${ii}$_dlasyf_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
real(sp), intent(inout) :: a(lda,*),h(ldh,*)
real(sp), intent(out) :: work(*)
end subroutine slasyf_aa
#else
module procedure stdlib${ii}$_slasyf_aa
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(in) :: m,nb,j1,lda,ldh
integer(${ik}$), intent(out) :: ipiv(*)
complex(dp), intent(inout) :: a(lda,*),h(ldh,*)
complex(dp), intent(out) :: work(*)
end subroutine zlasyf_aa
#else
module procedure stdlib${ii}$_zlasyf_aa
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_aa
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_aa
#:endif
#:endfor
#:endfor
end interface lasyf_aa
interface lasyf_rk
!! LASYF_RK computes a partial factorization of a complex symmetric
!! matrix A using the bounded Bunch-Kaufman (rook) diagonal
!! pivoting method. The partial factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**T U22**T )
!! A = ( L11 0 ) ( D 0 ) ( L11**T L21**T ) if UPLO = 'L',
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! LASYF_RK is an auxiliary routine called by CSYTRF_RK. It uses
!! blocked code (calling Level 3 BLAS) to update the submatrix
!! A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: e(*),w(ldw,*)
end subroutine clasyf_rk
#else
module procedure stdlib${ii}$_clasyf_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: e(*),w(ldw,*)
end subroutine dlasyf_rk
#else
module procedure stdlib${ii}$_dlasyf_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: e(*),w(ldw,*)
end subroutine slasyf_rk
#else
module procedure stdlib${ii}$_slasyf_rk
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: e(*),w(ldw,*)
end subroutine zlasyf_rk
#else
module procedure stdlib${ii}$_zlasyf_rk
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_rk
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_rk
#:endif
#:endfor
#:endfor
end interface lasyf_rk
interface lasyf_rook
!! LASYF_ROOK computes a partial factorization of a complex symmetric
!! matrix A using the bounded Bunch-Kaufman ("rook") diagonal
!! pivoting method. The partial factorization has the form:
!! A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
!! ( 0 U22 ) ( 0 D ) ( U12**T U22**T )
!! A = ( L11 0 ) ( D 0 ) ( L11**T L21**T ) if UPLO = 'L'
!! ( L21 I ) ( 0 A22 ) ( 0 I )
!! where the order of D is at most NB. The actual order is returned in
!! the argument KB, and is either NB or NB-1, or N if N <= NB.
!! LASYF_ROOK is an auxiliary routine called by CSYTRF_ROOK. It uses
!! blocked code (calling Level 3 BLAS) to update the submatrix
!! A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(sp), intent(inout) :: a(lda,*)
complex(sp), intent(out) :: w(ldw,*)
end subroutine clasyf_rook
#else
module procedure stdlib${ii}$_clasyf_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(dp), intent(inout) :: a(lda,*)
real(dp), intent(out) :: w(ldw,*)
end subroutine dlasyf_rook
#else
module procedure stdlib${ii}$_dlasyf_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
real(sp), intent(inout) :: a(lda,*)
real(sp), intent(out) :: w(ldw,*)
end subroutine slasyf_rook
#else
module procedure stdlib${ii}$_slasyf_rook
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: uplo
integer(${ik}$), intent(out) :: info,kb,ipiv(*)
integer(${ik}$), intent(in) :: lda,ldw,n,nb
complex(dp), intent(inout) :: a(lda,*)
complex(dp), intent(out) :: w(ldw,*)
end subroutine zlasyf_rook
#else
module procedure stdlib${ii}$_zlasyf_rook
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_rook
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$lasyf_rook
#:endif
#:endfor
#:endfor
end interface lasyf_rook
interface latbs
!! LATBS solves one of the triangular systems
!! A * x = s*b, A**T * x = s*b, or A**H * x = s*b,
!! with scaling to prevent overflow, where A is an upper or lower
!! triangular band matrix. Here A**T denotes the transpose of A, x and b
!! are n-element vectors, and s is a scaling factor, usually less than
!! or equal to 1, chosen so that the components of x will be less than
!! the overflow threshold. If the unscaled problem will not cause
!! overflow, the Level 2 BLAS routine CTBSV is called. If the matrix A
!! is singular (A(j,j) = 0 for some j), then s is set to 0 and a
!! non-trivial solution to A*x = 0 is returned.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,n
real(sp), intent(out) :: scale
real(sp), intent(inout) :: cnorm(*)
complex(sp), intent(in) :: ab(ldab,*)
complex(sp), intent(inout) :: x(*)
end subroutine clatbs
#else
module procedure stdlib${ii}$_clatbs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,n
real(dp), intent(out) :: scale
real(dp), intent(in) :: ab(ldab,*)
real(dp), intent(inout) :: cnorm(*),x(*)
end subroutine dlatbs
#else
module procedure stdlib${ii}$_dlatbs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,n
real(sp), intent(out) :: scale
real(sp), intent(in) :: ab(ldab,*)
real(sp), intent(inout) :: cnorm(*),x(*)
end subroutine slatbs
#else
module procedure stdlib${ii}$_slatbs
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,&
info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: kd,ldab,n
real(dp), intent(out) :: scale
real(dp), intent(inout) :: cnorm(*)
complex(dp), intent(in) :: ab(ldab,*)
complex(dp), intent(inout) :: x(*)
end subroutine zlatbs
#else
module procedure stdlib${ii}$_zlatbs
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$latbs
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$latbs
#:endif
#:endfor
#:endfor
end interface latbs
interface latdf
!! LATDF computes the contribution to the reciprocal Dif-estimate
!! by solving for x in Z * x = b, where b is chosen such that the norm
!! of x is as large as possible. It is assumed that LU decomposition
!! of Z has been computed by CGETC2. On entry RHS = f holds the
!! contribution from earlier solved sub-systems, and on return RHS = x.
!! The factorization of Z returned by CGETC2 has the form
!! Z = P * L * U * Q, where P and Q are permutation matrices. L is lower
!! triangular with unit diagonal elements and U is upper triangular.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,ldz,n,ipiv(*),jpiv(*)
real(sp), intent(inout) :: rdscal,rdsum
complex(sp), intent(inout) :: rhs(*),z(ldz,*)
end subroutine clatdf
#else
module procedure stdlib${ii}$_clatdf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,ldz,n,ipiv(*),jpiv(*)
real(dp), intent(inout) :: rdscal,rdsum,rhs(*),z(ldz,*)
end subroutine dlatdf
#else
module procedure stdlib${ii}$_dlatdf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,ldz,n,ipiv(*),jpiv(*)
real(sp), intent(inout) :: rdscal,rdsum,rhs(*),z(ldz,*)
end subroutine slatdf
#else
module procedure stdlib${ii}$_slatdf
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv )
import sp,dp,qp,${ik}$,lk
implicit none
integer(${ik}$), intent(in) :: ijob,ldz,n,ipiv(*),jpiv(*)
real(dp), intent(inout) :: rdscal,rdsum
complex(dp), intent(inout) :: rhs(*),z(ldz,*)
end subroutine zlatdf
#else
module procedure stdlib${ii}$_zlatdf
#endif
#:for rk,rt,ri in REAL_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$latdf
#:endif
#:endfor
#:for rk,rt,ri in CMPLX_KINDS_TYPES
#:if not rk in ["sp","dp"]
module procedure stdlib${ii}$_${ri}$latdf
#:endif
#:endfor
#:endfor
end interface latdf
interface latps
!! LATPS solves one of the triangular systems
!! A * x = s*b, A**T * x = s*b, or A**H * x = s*b,
!! with scaling to prevent overflow, where A is an upper or lower
!! triangular matrix stored in packed form. Here A**T denotes the
!! transpose of A, A**H denotes the conjugate transpose of A, x and b
!! are n-element vectors, and s is a scaling factor, usually less than
!! or equal to 1, chosen so that the components of x will be less than
!! the overflow threshold. If the unscaled problem will not cause
!! overflow, the Level 2 BLAS routine CTPSV is called. If the matrix A
!! is singular (A(j,j) = 0 for some j), then s is set to 0 and a
!! non-trivial solution to A*x = 0 is returned.
#:for ik,it,ii in LINALG_INT_KINDS_TYPES
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: scale
real(sp), intent(inout) :: cnorm(*)
complex(sp), intent(in) :: ap(*)
complex(sp), intent(inout) :: x(*)
end subroutine clatps
#else
module procedure stdlib${ii}$_clatps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine dlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(dp), intent(out) :: scale
real(dp), intent(in) :: ap(*)
real(dp), intent(inout) :: cnorm(*),x(*)
end subroutine dlatps
#else
module procedure stdlib${ii}$_dlatps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine slatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info )
import sp,dp,qp,${ik}$,lk
implicit none
character, intent(in) :: diag,normin,trans,uplo
integer(${ik}$), intent(out) :: info
integer(${ik}$), intent(in) :: n
real(sp), intent(out) :: scale
real(sp), intent(in) :: ap(*)
real(sp), intent(inout) :: cnorm(*),x(*)
end subroutine slatps
#else
module procedure stdlib${ii}$_slatps
#endif
#ifdef STDLIB_EXTERNAL_LAPACK${ii}$
pure subroutine zlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info )
